From 8122c63bbc8ed12d155f1e3ca2f95bdb3bd59cae Mon Sep 17 00:00:00 2001 From: meganfrisella Date: Mon, 5 Jun 2023 14:46:55 -0700 Subject: [PATCH 001/239] fstar queue library interface and implementation --- ulib/FStar.Queue.fst | 79 +++++++++++++++++++++++++++++++++++++++++++ ulib/FStar.Queue.fsti | 56 ++++++++++++++++++++++++++++++ 2 files changed, 135 insertions(+) create mode 100644 ulib/FStar.Queue.fst create mode 100644 ulib/FStar.Queue.fsti diff --git a/ulib/FStar.Queue.fst b/ulib/FStar.Queue.fst new file mode 100644 index 00000000000..1d9bb4b29d2 --- /dev/null +++ b/ulib/FStar.Queue.fst @@ -0,0 +1,79 @@ +module FStar.Queue + +open FStar.List.Tot + +type queue a = p:(list a & list a){isEmpty (fst p) ==> isEmpty (snd p)} + +let empty #a = [], [] + +let as_list #a q + = match (fst q) with + | [] -> [] + | _ -> append (fst q) (rev (snd q)) + +let as_queue #a l + = match l with + | [] -> empty + | _ -> l, [] + +let equal #a q1 q2 = as_list q1 == as_list q2 + +let lemma_eq_intro #_ q1 q2 = () + +let lemma_eq_elim #_ q1 q2 = admit() + +let lemma_as_list_as_queue_inv (#a:Type) (l:list a) + : Lemma (as_list (as_queue l) == l) + = match l with + | [] -> () + | _ -> append_l_nil l + +let lemma_as_queue_as_list_inv (#a:Type) (q:queue a) + : Lemma (as_queue (as_list q) == q) + = match fst q with + | [] -> () + | l -> ( + append_l_nil (append l (rev (snd q))); + lemma_eq_intro (as_queue (as_list q)) q + ) + +let enqueue (#a:Type) (x:a) (q:queue a) + : queue a + = match fst q with + | [] -> [x], [] + | l -> l, x :: (snd q) + +let dequeue (#a:Type) (q:queue a{not_empty q}) + : a & queue a + = let hd :: tl = fst q in + match tl with + | [] -> hd, (rev (snd q), []) + | _ -> hd, (tl, (snd q)) + +let peek (#a:Type) (q:queue a{not_empty q}) + : a + = hd (fst q) + +let lemma_empty_ok (#a:Type) + : Lemma (as_list #a empty == []) + = () + +let lemma_enqueue_ok (#a:Type) (x:a) (q:queue a) + : Lemma (as_list (enqueue x q) == append (as_list q) [x]) + = match fst q with + | [] -> () + | l -> ( + append_assoc l (rev (snd q)) [x]; + rev_append [x] (snd q) + ) + +let lemma_dequeue_ok (#a:Type) (q:queue a{not_empty q}) + : Lemma (as_list q == (fst (dequeue q)) :: as_list (snd (dequeue q))) + = let hd :: tl = fst q in + match tl with + | [] -> append_l_nil (rev (snd q)) + | _ -> append_assoc [hd] tl (rev (snd q)) + +let lemma_peek_ok (#a:Type) (q:queue a{not_empty q}) + : Lemma (hd (as_list q) == peek q) + = () \ No newline at end of file diff --git a/ulib/FStar.Queue.fsti b/ulib/FStar.Queue.fsti new file mode 100644 index 00000000000..e65cb1bb7b6 --- /dev/null +++ b/ulib/FStar.Queue.fsti @@ -0,0 +1,56 @@ +module FStar.Queue + +open FStar.List.Tot + +val queue (a:Type u#a) : Type u#a + +val empty (#a:Type) : queue a + +val as_list (#a:Type) (q:queue a) : list a + +val as_queue (#a:Type) (l:list a) : queue a + +val equal (#a:Type) (q1 q2:queue a) : prop + +val lemma_eq_intro: #a:Type -> q1:queue a -> q2:queue a -> Lemma + (requires (as_list q1 == as_list q2)) + (ensures (equal q1 q2)) + [SMTPat (equal q1 q2)] + +val lemma_eq_elim: #a:Type -> q1:queue a -> q2:queue a -> Lemma + (requires (equal q1 q2)) + (ensures q1 == q2) + [SMTPat (equal q1 q2)] + +let not_empty (#a:Type) (q:queue a) : prop + = ~(as_list q == []) + +val lemma_as_list_as_queue_inv: #a:Type -> l:list a -> Lemma + (as_list (as_queue l) == l) + [SMTPat (as_queue l)] + +val lemma_as_queue_as_list_inv: #a:Type -> q:queue a -> Lemma + (as_queue (as_list q) == q) + [SMTPat (as_list q)] + +val enqueue (#a:Type) (x:a) (q:queue a) : queue a + +val dequeue (#a:Type) (q:queue a{not_empty q}) : a & queue a + +val peek (#a:Type) (q:queue a{not_empty q}) : a + +val lemma_empty_ok: #a:Type -> Lemma + (as_list #a empty == []) + [SMTPat (empty #a)] + +val lemma_enqueue_ok: #a:Type -> x:a -> q:queue a -> Lemma + (as_list (enqueue x q) == append (as_list q) [x]) + [SMTPat (enqueue x q)] + +val dequeue_ok: #a:Type -> q:queue a{not_empty q} -> Lemma + ((fst (dequeue q) :: as_list (snd (dequeue q))) == as_list q) + [SMTPat (dequeue q)] + +val peek_ok: #a:Type -> q:queue a{not_empty q} -> Lemma + (peek q == hd (as_list q)) + [SMTPat (peek q)] \ No newline at end of file From 3528082bc0c9f40484bfce6336746024a4586fa7 Mon Sep 17 00:00:00 2001 From: meganfrisella Date: Mon, 5 Jun 2023 15:29:04 -0700 Subject: [PATCH 002/239] change names to match interface --- ulib/FStar.Queue.fsti | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ulib/FStar.Queue.fsti b/ulib/FStar.Queue.fsti index e65cb1bb7b6..d571db547d7 100644 --- a/ulib/FStar.Queue.fsti +++ b/ulib/FStar.Queue.fsti @@ -47,10 +47,10 @@ val lemma_enqueue_ok: #a:Type -> x:a -> q:queue a -> Lemma (as_list (enqueue x q) == append (as_list q) [x]) [SMTPat (enqueue x q)] -val dequeue_ok: #a:Type -> q:queue a{not_empty q} -> Lemma +val lemma_dequeue_ok: #a:Type -> q:queue a{not_empty q} -> Lemma ((fst (dequeue q) :: as_list (snd (dequeue q))) == as_list q) [SMTPat (dequeue q)] -val peek_ok: #a:Type -> q:queue a{not_empty q} -> Lemma +val lemma_peek_ok: #a:Type -> q:queue a{not_empty q} -> Lemma (peek q == hd (as_list q)) [SMTPat (peek q)] \ No newline at end of file From c49333a41d7a3b4527948d5bc20b5649415d3d5a Mon Sep 17 00:00:00 2001 From: meganfrisella Date: Mon, 5 Jun 2023 15:49:11 -0700 Subject: [PATCH 003/239] queue tests --- tests/micro-benchmarks/TestQueue.fst | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 tests/micro-benchmarks/TestQueue.fst diff --git a/tests/micro-benchmarks/TestQueue.fst b/tests/micro-benchmarks/TestQueue.fst new file mode 100644 index 00000000000..23afc8cdb01 --- /dev/null +++ b/tests/micro-benchmarks/TestQueue.fst @@ -0,0 +1,17 @@ +module TestQueue +open FStar.Queue + +let my_empty = as_queue [] +let my_queue = as_queue [1] +let my_queue2 = as_queue #int [1; 2; 3] + +// let lemma_my_queue_not_empty : #a:Type -> Lemma (not_empty my_queue) = admit() + +#push-options "--print_implicits --print_universes --query_stats" +let _ = assert (empty #bool == my_empty) +let _ = assert (empty #int == my_empty) +let _ = assert (equal (enqueue 2 my_queue) (as_queue [1; 2])) +let _ = assert (dequeue my_queue == 1, as_queue [2; 3]) +let _ = assert (dequeue (enqueue 1 my_empty) == 1, my_empty) +let _ = assert (peek my_queue == 1) +let _ = assert (peek (snd (dequeue my_queue)) == 2) \ No newline at end of file From 9b3c560a6d572b296ebbc6f56780645e2536f6f1 Mon Sep 17 00:00:00 2001 From: meganfrisella Date: Mon, 5 Jun 2023 23:57:17 -0700 Subject: [PATCH 004/239] fix lemma_enqueue_ok and lemma_eq_elim --- tests/micro-benchmarks/TestQueue.fst | 32 +++++++++++++++++----------- ulib/FStar.Queue.fst | 9 ++++---- ulib/FStar.Queue.fsti | 18 ++++++++-------- 3 files changed, 32 insertions(+), 27 deletions(-) diff --git a/tests/micro-benchmarks/TestQueue.fst b/tests/micro-benchmarks/TestQueue.fst index 23afc8cdb01..2a28f4de1c2 100644 --- a/tests/micro-benchmarks/TestQueue.fst +++ b/tests/micro-benchmarks/TestQueue.fst @@ -1,17 +1,23 @@ module TestQueue open FStar.Queue -let my_empty = as_queue [] -let my_queue = as_queue [1] -let my_queue2 = as_queue #int [1; 2; 3] +let my_queue = enqueue 3 (enqueue 2 (enqueue 1 empty)) -// let lemma_my_queue_not_empty : #a:Type -> Lemma (not_empty my_queue) = admit() - -#push-options "--print_implicits --print_universes --query_stats" -let _ = assert (empty #bool == my_empty) -let _ = assert (empty #int == my_empty) -let _ = assert (equal (enqueue 2 my_queue) (as_queue [1; 2])) -let _ = assert (dequeue my_queue == 1, as_queue [2; 3]) -let _ = assert (dequeue (enqueue 1 my_empty) == 1, my_empty) -let _ = assert (peek my_queue == 1) -let _ = assert (peek (snd (dequeue my_queue)) == 2) \ No newline at end of file +let _ = assert + (eq my_queue + (as_queue [1; 2; 3])) +let _ = assert + (eq (enqueue 4 my_queue) + (as_queue [1; 2; 3; 4])) +let _ = assert + (fst (dequeue my_queue) == 1) +let _ = assert + (eq (snd (dequeue my_queue)) + (enqueue 3 (enqueue 2 empty))) +let _ = assert + (eq (snd (dequeue (enqueue 1 empty))) + empty) +let _ = assert + (peek my_queue == 1) +let _ = assert + (peek (snd (dequeue my_queue)) == 2) \ No newline at end of file diff --git a/ulib/FStar.Queue.fst b/ulib/FStar.Queue.fst index 1d9bb4b29d2..ef9c69e9853 100644 --- a/ulib/FStar.Queue.fst +++ b/ulib/FStar.Queue.fst @@ -16,11 +16,11 @@ let as_queue #a l | [] -> empty | _ -> l, [] -let equal #a q1 q2 = as_list q1 == as_list q2 +let eq #a q1 q2 = as_list q1 == as_list q2 let lemma_eq_intro #_ q1 q2 = () -let lemma_eq_elim #_ q1 q2 = admit() +let lemma_eq_elim #_ q1 q2 = () let lemma_as_list_as_queue_inv (#a:Type) (l:list a) : Lemma (as_list (as_queue l) == l) @@ -29,12 +29,11 @@ let lemma_as_list_as_queue_inv (#a:Type) (l:list a) | _ -> append_l_nil l let lemma_as_queue_as_list_inv (#a:Type) (q:queue a) - : Lemma (as_queue (as_list q) == q) + : Lemma (eq (as_queue (as_list q)) q) = match fst q with | [] -> () | l -> ( - append_l_nil (append l (rev (snd q))); - lemma_eq_intro (as_queue (as_list q)) q + append_l_nil (append l (rev (snd q))) ) let enqueue (#a:Type) (x:a) (q:queue a) diff --git a/ulib/FStar.Queue.fsti b/ulib/FStar.Queue.fsti index d571db547d7..9df6df02113 100644 --- a/ulib/FStar.Queue.fsti +++ b/ulib/FStar.Queue.fsti @@ -10,17 +10,17 @@ val as_list (#a:Type) (q:queue a) : list a val as_queue (#a:Type) (l:list a) : queue a -val equal (#a:Type) (q1 q2:queue a) : prop +val eq (#a:Type) (q1 q2:queue a) : prop val lemma_eq_intro: #a:Type -> q1:queue a -> q2:queue a -> Lemma - (requires (as_list q1 == as_list q2)) - (ensures (equal q1 q2)) - [SMTPat (equal q1 q2)] + (requires as_list q1 == as_list q2) + (ensures (eq q1 q2)) + [SMTPat (eq q1 q2)] val lemma_eq_elim: #a:Type -> q1:queue a -> q2:queue a -> Lemma - (requires (equal q1 q2)) - (ensures q1 == q2) - [SMTPat (equal q1 q2)] + (requires (eq q1 q2)) + (ensures as_list q1 == as_list q2) + [SMTPat (eq q1 q2)] let not_empty (#a:Type) (q:queue a) : prop = ~(as_list q == []) @@ -30,7 +30,7 @@ val lemma_as_list_as_queue_inv: #a:Type -> l:list a -> Lemma [SMTPat (as_queue l)] val lemma_as_queue_as_list_inv: #a:Type -> q:queue a -> Lemma - (as_queue (as_list q) == q) + (eq (as_queue (as_list q)) q) [SMTPat (as_list q)] val enqueue (#a:Type) (x:a) (q:queue a) : queue a @@ -44,7 +44,7 @@ val lemma_empty_ok: #a:Type -> Lemma [SMTPat (empty #a)] val lemma_enqueue_ok: #a:Type -> x:a -> q:queue a -> Lemma - (as_list (enqueue x q) == append (as_list q) [x]) + (as_list (enqueue x q) == (as_list q) @ [x]) [SMTPat (enqueue x q)] val lemma_dequeue_ok: #a:Type -> q:queue a{not_empty q} -> Lemma From 57f17c15c8130e0dcaa77d72329aee9392113ed0 Mon Sep 17 00:00:00 2001 From: meganfrisella Date: Tue, 6 Jun 2023 14:16:43 -0700 Subject: [PATCH 005/239] seq representation for queue interface specs. queue tests currently broken --- ulib/FStar.Queue.fst | 104 ++++++++++++++++++++++++++++++------------ ulib/FStar.Queue.fsti | 37 +++++++-------- 2 files changed, 94 insertions(+), 47 deletions(-) diff --git a/ulib/FStar.Queue.fst b/ulib/FStar.Queue.fst index ef9c69e9853..5f6b4803ec2 100644 --- a/ulib/FStar.Queue.fst +++ b/ulib/FStar.Queue.fst @@ -1,41 +1,66 @@ module FStar.Queue -open FStar.List.Tot +module L = FStar.List.Tot +open FStar.Seq -type queue a = p:(list a & list a){isEmpty (fst p) ==> isEmpty (snd p)} +type queue a = p:(list a & list a){L.isEmpty (fst p) ==> L.isEmpty (snd p)} let empty #a = [], [] -let as_list #a q +val queue_to_list (#a:Type) (q:queue a) : list a +let queue_to_list #a q = match (fst q) with | [] -> [] - | _ -> append (fst q) (rev (snd q)) + | _ -> (fst q) @ (L.rev (snd q)) -let as_queue #a l +val queue_of_list (#a:Type) (l:list a) : queue a +let queue_of_list #a l = match l with | [] -> empty | _ -> l, [] -let eq #a q1 q2 = as_list q1 == as_list q2 +let queue_to_seq #a q + = seq_of_list (queue_to_list q) + +let queue_of_seq #a s + = queue_of_list (seq_to_list s) + +let eq #a q1 q2 = queue_to_seq q1 == queue_to_seq q2 let lemma_eq_intro #_ q1 q2 = () let lemma_eq_elim #_ q1 q2 = () -let lemma_as_list_as_queue_inv (#a:Type) (l:list a) - : Lemma (as_list (as_queue l) == l) +let lemma_list_queue_bij (#a:Type) (l:list a) + : Lemma (queue_to_list (queue_of_list l) == l) = match l with | [] -> () - | _ -> append_l_nil l + | _ -> L.append_l_nil l -let lemma_as_queue_as_list_inv (#a:Type) (q:queue a) - : Lemma (eq (as_queue (as_list q)) q) +let lemma_queue_list_bij (#a:Type) (q:queue a) + : Lemma (eq (queue_of_list (queue_to_list q)) q) = match fst q with | [] -> () | l -> ( - append_l_nil (append l (rev (snd q))) + L.append_l_nil (L.append l (L.rev (snd q))) ) +let lemma_seq_queue_bij (#a:Type) (s:seq a) + : Lemma (queue_to_seq (queue_of_seq s) == s) + = let l = (seq_to_list s) in + lemma_list_queue_bij l; + lemma_seq_list_bij s + +let lemma_queue_seq_bij (#a:Type) (q:queue a) + : Lemma (eq (queue_of_seq (queue_to_seq q)) q) + = let l = (queue_to_list q) in + lemma_queue_list_bij q; + lemma_list_seq_bij l + +let lemma_seq_to_list_empty (#a:Type) (s:seq a) + : Lemma (s == Seq.empty ==> seq_to_list s == []) + = lemma_list_seq_bij (seq_to_list s) + let enqueue (#a:Type) (x:a) (q:queue a) : queue a = match fst q with @@ -44,35 +69,56 @@ let enqueue (#a:Type) (x:a) (q:queue a) let dequeue (#a:Type) (q:queue a{not_empty q}) : a & queue a - = let hd :: tl = fst q in + = lemma_seq_to_list_empty (queue_to_seq q); + let hd :: tl = fst q in match tl with - | [] -> hd, (rev (snd q), []) + | [] -> hd, (L.rev (snd q), []) | _ -> hd, (tl, (snd q)) let peek (#a:Type) (q:queue a{not_empty q}) : a - = hd (fst q) + = lemma_seq_to_list_empty (queue_to_seq q); + L.hd (fst q) -let lemma_empty_ok (#a:Type) - : Lemma (as_list #a empty == []) - = () +let lemma_empty_ok (#a:Type) + : Lemma (queue_to_seq #a empty == Seq.empty) + = lemma_seq_list_bij #a Seq.empty -let lemma_enqueue_ok (#a:Type) (x:a) (q:queue a) - : Lemma (as_list (enqueue x q) == append (as_list q) [x]) +let lemma_enqueue_ok_list (#a:Type) (x:a) (q:queue a) + : Lemma (queue_to_list (enqueue x q) == L.snoc ((queue_to_list q),x)) = match fst q with | [] -> () | l -> ( - append_assoc l (rev (snd q)) [x]; - rev_append [x] (snd q) + L.append_assoc l (L.rev (snd q)) [x]; + L.rev_append [x] (snd q) ) -let lemma_dequeue_ok (#a:Type) (q:queue a{not_empty q}) - : Lemma (as_list q == (fst (dequeue q)) :: as_list (snd (dequeue q))) - = let hd :: tl = fst q in +let lemma_snoc_list_seq (#a:Type) (x:a) (q:queue a) + : Lemma (seq_of_list (L.snoc ((queue_to_list q),x)) == Seq.snoc (queue_to_seq q) x) + = admit() + +let lemma_enqueue_ok (#a:Type) (x:a) (q:queue a) + : Lemma (queue_to_seq (enqueue x q) == Seq.snoc (queue_to_seq q) x) + = lemma_enqueue_ok_list x q; + lemma_snoc_list_seq x q + +let lemma_dequeue_ok_list (#a:Type) (q:queue a{not_empty q}) + : Lemma (fst (dequeue q) :: queue_to_list (snd (dequeue q)) == queue_to_list q) + = lemma_seq_to_list_empty (queue_to_seq q); + let hd :: tl = fst q in match tl with - | [] -> append_l_nil (rev (snd q)) - | _ -> append_assoc [hd] tl (rev (snd q)) + | [] -> L.append_l_nil (L.rev (snd q)) + | _ -> L.append_assoc [hd] tl (L.rev (snd q)) + +let lemma_cons_list_seq (#a:Type) (x:a) (q:queue a) + : Lemma (seq_of_list (x :: (queue_to_list q)) == Seq.cons x (queue_to_seq q)) + = admit() + +let lemma_dequeue_ok (#a:Type) (q:queue a{not_empty q}) + : Lemma (Seq.cons (fst (dequeue q)) (queue_to_seq (snd (dequeue q))) == queue_to_seq q) + = lemma_dequeue_ok_list q; + lemma_cons_list_seq (fst (dequeue q)) (snd (dequeue q)) let lemma_peek_ok (#a:Type) (q:queue a{not_empty q}) - : Lemma (hd (as_list q) == peek q) - = () \ No newline at end of file + : Lemma (peek q == index (queue_to_seq q) 0) + = lemma_dequeue_ok_list q \ No newline at end of file diff --git a/ulib/FStar.Queue.fsti b/ulib/FStar.Queue.fsti index 9df6df02113..7bae13595ee 100644 --- a/ulib/FStar.Queue.fsti +++ b/ulib/FStar.Queue.fsti @@ -1,37 +1,38 @@ module FStar.Queue -open FStar.List.Tot +open FStar.Seq val queue (a:Type u#a) : Type u#a val empty (#a:Type) : queue a -val as_list (#a:Type) (q:queue a) : list a +val queue_to_seq (#a:Type) (q:queue a) : seq a -val as_queue (#a:Type) (l:list a) : queue a +val queue_of_seq (#a:Type) (s:seq a) : queue a val eq (#a:Type) (q1 q2:queue a) : prop +let not_empty (#a:Type) (q:queue a) : prop + = let s = queue_to_seq q in + ~(s == Seq.empty) /\ length s > 0 + val lemma_eq_intro: #a:Type -> q1:queue a -> q2:queue a -> Lemma - (requires as_list q1 == as_list q2) + (requires queue_to_seq q1 == queue_to_seq q2) (ensures (eq q1 q2)) [SMTPat (eq q1 q2)] val lemma_eq_elim: #a:Type -> q1:queue a -> q2:queue a -> Lemma (requires (eq q1 q2)) - (ensures as_list q1 == as_list q2) + (ensures queue_to_seq q1 == queue_to_seq q2) [SMTPat (eq q1 q2)] -let not_empty (#a:Type) (q:queue a) : prop - = ~(as_list q == []) - -val lemma_as_list_as_queue_inv: #a:Type -> l:list a -> Lemma - (as_list (as_queue l) == l) - [SMTPat (as_queue l)] +val lemma_seq_queue_bij: #a:Type -> s:seq a -> Lemma + (queue_to_seq (queue_of_seq s) == s) + [SMTPat (queue_of_seq s)] -val lemma_as_queue_as_list_inv: #a:Type -> q:queue a -> Lemma - (eq (as_queue (as_list q)) q) - [SMTPat (as_list q)] +val lemma_queue_seq_bij: #a:Type -> q:queue a -> Lemma + (eq (queue_of_seq (queue_to_seq q)) q) + [SMTPat (queue_to_seq q)] val enqueue (#a:Type) (x:a) (q:queue a) : queue a @@ -40,17 +41,17 @@ val dequeue (#a:Type) (q:queue a{not_empty q}) : a & queue a val peek (#a:Type) (q:queue a{not_empty q}) : a val lemma_empty_ok: #a:Type -> Lemma - (as_list #a empty == []) + (queue_to_seq #a empty == Seq.empty) [SMTPat (empty #a)] val lemma_enqueue_ok: #a:Type -> x:a -> q:queue a -> Lemma - (as_list (enqueue x q) == (as_list q) @ [x]) + (queue_to_seq (enqueue x q) == Seq.snoc (queue_to_seq q) x) [SMTPat (enqueue x q)] val lemma_dequeue_ok: #a:Type -> q:queue a{not_empty q} -> Lemma - ((fst (dequeue q) :: as_list (snd (dequeue q))) == as_list q) + (Seq.cons (fst (dequeue q)) (queue_to_seq (snd (dequeue q))) == queue_to_seq q) [SMTPat (dequeue q)] val lemma_peek_ok: #a:Type -> q:queue a{not_empty q} -> Lemma - (peek q == hd (as_list q)) + (peek q == index (queue_to_seq q) 0) [SMTPat (peek q)] \ No newline at end of file From 27c7596cf2751d203d2e808b66e56c3cd89312a2 Mon Sep 17 00:00:00 2001 From: meganfrisella Date: Tue, 6 Jun 2023 15:32:44 -0700 Subject: [PATCH 006/239] proof progress -- one admit left on FStar.Queue.fst:111. unclear why F* cannot validate test assertions. will keep digging --- tests/micro-benchmarks/TestQueue.fst | 36 +++++++++++++------------- ulib/FStar.Queue.fst | 38 ++++++++++++++++++++++++++-- 2 files changed, 55 insertions(+), 19 deletions(-) diff --git a/tests/micro-benchmarks/TestQueue.fst b/tests/micro-benchmarks/TestQueue.fst index 2a28f4de1c2..4fa9355ff93 100644 --- a/tests/micro-benchmarks/TestQueue.fst +++ b/tests/micro-benchmarks/TestQueue.fst @@ -1,23 +1,25 @@ module TestQueue + open FStar.Queue +open FStar.Seq -let my_queue = enqueue 3 (enqueue 2 (enqueue 1 empty)) +let my_queue = enqueue 3 (enqueue 2 (enqueue 1 Queue.empty)) +let my_seq = Seq.cons 1 (Seq.cons 2 (Seq.cons 3 Seq.empty)) -let _ = assert - (eq my_queue - (as_queue [1; 2; 3])) -let _ = assert - (eq (enqueue 4 my_queue) - (as_queue [1; 2; 3; 4])) -let _ = assert - (fst (dequeue my_queue) == 1) -let _ = assert - (eq (snd (dequeue my_queue)) - (enqueue 3 (enqueue 2 empty))) -let _ = assert - (eq (snd (dequeue (enqueue 1 empty))) - empty) +// let _ = assert +// (eq my_queue (queue_of_seq my_seq)) +// let _ = assert +// (eq (enqueue 4 my_queue) +// (queue_of_seq (Seq.snoc my_queue 4))) +// let _ = assert +// (fst (dequeue my_queue) == 1) +// let _ = assert +// (eq (snd (dequeue my_queue)) +// (enqueue 3 (enqueue 2 empty))) +// let _ = assert +// (eq (snd (dequeue (enqueue 1 empty))) +// empty) let _ = assert (peek my_queue == 1) -let _ = assert - (peek (snd (dequeue my_queue)) == 2) \ No newline at end of file +// let _ = assert +// (peek (snd (dequeue my_queue)) == 2) \ No newline at end of file diff --git a/ulib/FStar.Queue.fst b/ulib/FStar.Queue.fst index 5f6b4803ec2..3cac1d9a900 100644 --- a/ulib/FStar.Queue.fst +++ b/ulib/FStar.Queue.fst @@ -3,8 +3,10 @@ module FStar.Queue module L = FStar.List.Tot open FStar.Seq +(* write comment *) type queue a = p:(list a & list a){L.isEmpty (fst p) ==> L.isEmpty (snd p)} +(* write comment *) let empty #a = [], [] val queue_to_list (#a:Type) (q:queue a) : list a @@ -19,16 +21,21 @@ let queue_of_list #a l | [] -> empty | _ -> l, [] +(* write comment *) let queue_to_seq #a q = seq_of_list (queue_to_list q) +(* write comment *) let queue_of_seq #a s = queue_of_list (seq_to_list s) +(* write comment *) let eq #a q1 q2 = queue_to_seq q1 == queue_to_seq q2 +(* write comment *) let lemma_eq_intro #_ q1 q2 = () +(* write comment *) let lemma_eq_elim #_ q1 q2 = () let lemma_list_queue_bij (#a:Type) (l:list a) @@ -45,12 +52,14 @@ let lemma_queue_list_bij (#a:Type) (q:queue a) L.append_l_nil (L.append l (L.rev (snd q))) ) +(* write comment *) let lemma_seq_queue_bij (#a:Type) (s:seq a) : Lemma (queue_to_seq (queue_of_seq s) == s) = let l = (seq_to_list s) in lemma_list_queue_bij l; lemma_seq_list_bij s +(* write comment *) let lemma_queue_seq_bij (#a:Type) (q:queue a) : Lemma (eq (queue_of_seq (queue_to_seq q)) q) = let l = (queue_to_list q) in @@ -61,12 +70,14 @@ let lemma_seq_to_list_empty (#a:Type) (s:seq a) : Lemma (s == Seq.empty ==> seq_to_list s == []) = lemma_list_seq_bij (seq_to_list s) +(* write comment *) let enqueue (#a:Type) (x:a) (q:queue a) : queue a = match fst q with | [] -> [x], [] | l -> l, x :: (snd q) +(* write comment *) let dequeue (#a:Type) (q:queue a{not_empty q}) : a & queue a = lemma_seq_to_list_empty (queue_to_seq q); @@ -75,11 +86,13 @@ let dequeue (#a:Type) (q:queue a{not_empty q}) | [] -> hd, (L.rev (snd q), []) | _ -> hd, (tl, (snd q)) +(* write comment *) let peek (#a:Type) (q:queue a{not_empty q}) : a = lemma_seq_to_list_empty (queue_to_seq q); L.hd (fst q) +(* write comment *) let lemma_empty_ok (#a:Type) : Lemma (queue_to_seq #a empty == Seq.empty) = lemma_seq_list_bij #a Seq.empty @@ -93,10 +106,22 @@ let lemma_enqueue_ok_list (#a:Type) (x:a) (q:queue a) L.rev_append [x] (snd q) ) +let lemma_seq_to_list_dist_append (#a:Type) (s1 s2:seq a) + : Lemma (seq_to_list (Seq.append s1 s2) == L.append (seq_to_list s1) (seq_to_list s2)) + = admit() + +let lemma_snoc_seq_list (#a:Type) (x:a) (q:queue a) + : Lemma (L.snoc ((queue_to_list q),x) == (seq_to_list (Seq.snoc (queue_to_seq q) x))) + = let l = (queue_to_list q) in + lemma_seq_to_list_dist_append (seq_of_list l) (Seq.create 1 x); + lemma_list_seq_bij l + let lemma_snoc_list_seq (#a:Type) (x:a) (q:queue a) : Lemma (seq_of_list (L.snoc ((queue_to_list q),x)) == Seq.snoc (queue_to_seq q) x) - = admit() + = lemma_snoc_seq_list x q; + lemma_seq_list_bij (Seq.snoc (queue_to_seq q) x) +(* write comment *) let lemma_enqueue_ok (#a:Type) (x:a) (q:queue a) : Lemma (queue_to_seq (enqueue x q) == Seq.snoc (queue_to_seq q) x) = lemma_enqueue_ok_list x q; @@ -110,15 +135,24 @@ let lemma_dequeue_ok_list (#a:Type) (q:queue a{not_empty q}) | [] -> L.append_l_nil (L.rev (snd q)) | _ -> L.append_assoc [hd] tl (L.rev (snd q)) +let lemma_cons_seq_list (#a:Type) (x:a) (q:queue a) + : Lemma (x :: (queue_to_list q) == seq_to_list (Seq.cons x (queue_to_seq q))) + = let l = (queue_to_list q) in + lemma_seq_to_list_dist_append (Seq.create 1 x) (seq_of_list l); + lemma_list_seq_bij l + let lemma_cons_list_seq (#a:Type) (x:a) (q:queue a) : Lemma (seq_of_list (x :: (queue_to_list q)) == Seq.cons x (queue_to_seq q)) - = admit() + = lemma_cons_seq_list x q; + lemma_seq_list_bij (Seq.cons x (queue_to_seq q)) +(* write comment *) let lemma_dequeue_ok (#a:Type) (q:queue a{not_empty q}) : Lemma (Seq.cons (fst (dequeue q)) (queue_to_seq (snd (dequeue q))) == queue_to_seq q) = lemma_dequeue_ok_list q; lemma_cons_list_seq (fst (dequeue q)) (snd (dequeue q)) +(* write comment *) let lemma_peek_ok (#a:Type) (q:queue a{not_empty q}) : Lemma (peek q == index (queue_to_seq q) 0) = lemma_dequeue_ok_list q \ No newline at end of file From 75946558f1fcaf0e4b87c602e96a189dc0b0b17a Mon Sep 17 00:00:00 2001 From: meganfrisella Date: Wed, 7 Jun 2023 10:07:34 -0700 Subject: [PATCH 007/239] update dequeue spec. queue tests verify. --- tests/micro-benchmarks/TestQueue.fst | 33 ++++++++++++++-------------- ulib/FStar.Queue.fst | 8 ++++--- ulib/FStar.Queue.fsti | 10 +++++---- 3 files changed, 28 insertions(+), 23 deletions(-) diff --git a/tests/micro-benchmarks/TestQueue.fst b/tests/micro-benchmarks/TestQueue.fst index 4fa9355ff93..fed6753c788 100644 --- a/tests/micro-benchmarks/TestQueue.fst +++ b/tests/micro-benchmarks/TestQueue.fst @@ -1,25 +1,26 @@ module TestQueue +module Q = FStar.Queue open FStar.Queue open FStar.Seq -let my_queue = enqueue 3 (enqueue 2 (enqueue 1 Queue.empty)) +let my_queue = enqueue 3 (enqueue 2 (enqueue 1 Q.empty)) let my_seq = Seq.cons 1 (Seq.cons 2 (Seq.cons 3 Seq.empty)) -// let _ = assert -// (eq my_queue (queue_of_seq my_seq)) -// let _ = assert -// (eq (enqueue 4 my_queue) -// (queue_of_seq (Seq.snoc my_queue 4))) -// let _ = assert -// (fst (dequeue my_queue) == 1) -// let _ = assert -// (eq (snd (dequeue my_queue)) -// (enqueue 3 (enqueue 2 empty))) -// let _ = assert -// (eq (snd (dequeue (enqueue 1 empty))) -// empty) +let _ = assert + (Q.eq my_queue (queue_of_seq my_seq)) +let _ = assert + (Q.eq (enqueue 4 my_queue) + (queue_of_seq (Seq.snoc my_seq 4))) +let _ = assert + (fst (dequeue my_queue) == 1) +let _ = assert + (Q.eq (snd (dequeue my_queue)) + (enqueue 3 (enqueue 2 Q.empty))) +let _ = assert + (Q.eq (snd (dequeue (enqueue 1 Q.empty))) + Q.empty) let _ = assert (peek my_queue == 1) -// let _ = assert -// (peek (snd (dequeue my_queue)) == 2) \ No newline at end of file +let _ = assert + (peek (snd (dequeue my_queue)) == 2) \ No newline at end of file diff --git a/ulib/FStar.Queue.fst b/ulib/FStar.Queue.fst index 3cac1d9a900..0773e8dcd7d 100644 --- a/ulib/FStar.Queue.fst +++ b/ulib/FStar.Queue.fst @@ -148,11 +148,13 @@ let lemma_cons_list_seq (#a:Type) (x:a) (q:queue a) (* write comment *) let lemma_dequeue_ok (#a:Type) (q:queue a{not_empty q}) - : Lemma (Seq.cons (fst (dequeue q)) (queue_to_seq (snd (dequeue q))) == queue_to_seq q) - = lemma_dequeue_ok_list q; + : Lemma (let hd, tl = dequeue q in + hd == Seq.head (queue_to_seq q) /\ + eq tl (queue_of_seq (Seq.tail (queue_to_seq q)))) + = lemma_dequeue_ok_list q; lemma_cons_list_seq (fst (dequeue q)) (snd (dequeue q)) (* write comment *) let lemma_peek_ok (#a:Type) (q:queue a{not_empty q}) - : Lemma (peek q == index (queue_to_seq q) 0) + : Lemma (peek q == Seq.head (queue_to_seq q)) = lemma_dequeue_ok_list q \ No newline at end of file diff --git a/ulib/FStar.Queue.fsti b/ulib/FStar.Queue.fsti index 7bae13595ee..4a63e14bd11 100644 --- a/ulib/FStar.Queue.fsti +++ b/ulib/FStar.Queue.fsti @@ -14,10 +14,10 @@ val eq (#a:Type) (q1 q2:queue a) : prop let not_empty (#a:Type) (q:queue a) : prop = let s = queue_to_seq q in - ~(s == Seq.empty) /\ length s > 0 + ~(Seq.equal s Seq.empty) /\ length s > 0 val lemma_eq_intro: #a:Type -> q1:queue a -> q2:queue a -> Lemma - (requires queue_to_seq q1 == queue_to_seq q2) + (requires Seq.equal (queue_to_seq q1) (queue_to_seq q2)) (ensures (eq q1 q2)) [SMTPat (eq q1 q2)] @@ -49,9 +49,11 @@ val lemma_enqueue_ok: #a:Type -> x:a -> q:queue a -> Lemma [SMTPat (enqueue x q)] val lemma_dequeue_ok: #a:Type -> q:queue a{not_empty q} -> Lemma - (Seq.cons (fst (dequeue q)) (queue_to_seq (snd (dequeue q))) == queue_to_seq q) + (let hd, tl = dequeue q in + hd == Seq.head (queue_to_seq q) /\ + eq tl (queue_of_seq (Seq.tail (queue_to_seq q)))) [SMTPat (dequeue q)] val lemma_peek_ok: #a:Type -> q:queue a{not_empty q} -> Lemma - (peek q == index (queue_to_seq q) 0) + (peek q == Seq.head (queue_to_seq q)) [SMTPat (peek q)] \ No newline at end of file From d1b502ac15cdb6709374ec61384269744bbb8e67 Mon Sep 17 00:00:00 2001 From: meganfrisella Date: Wed, 7 Jun 2023 10:10:12 -0700 Subject: [PATCH 008/239] Queue.eq to Queue.equal --- tests/micro-benchmarks/TestQueue.fst | 8 ++++---- ulib/FStar.Queue.fst | 8 ++++---- ulib/FStar.Queue.fsti | 14 +++++++------- 3 files changed, 15 insertions(+), 15 deletions(-) diff --git a/tests/micro-benchmarks/TestQueue.fst b/tests/micro-benchmarks/TestQueue.fst index fed6753c788..3a6306cea67 100644 --- a/tests/micro-benchmarks/TestQueue.fst +++ b/tests/micro-benchmarks/TestQueue.fst @@ -8,17 +8,17 @@ let my_queue = enqueue 3 (enqueue 2 (enqueue 1 Q.empty)) let my_seq = Seq.cons 1 (Seq.cons 2 (Seq.cons 3 Seq.empty)) let _ = assert - (Q.eq my_queue (queue_of_seq my_seq)) + (Q.equal my_queue (queue_of_seq my_seq)) let _ = assert - (Q.eq (enqueue 4 my_queue) + (Q.equal (enqueue 4 my_queue) (queue_of_seq (Seq.snoc my_seq 4))) let _ = assert (fst (dequeue my_queue) == 1) let _ = assert - (Q.eq (snd (dequeue my_queue)) + (Q.equal (snd (dequeue my_queue)) (enqueue 3 (enqueue 2 Q.empty))) let _ = assert - (Q.eq (snd (dequeue (enqueue 1 Q.empty))) + (Q.equal (snd (dequeue (enqueue 1 Q.empty))) Q.empty) let _ = assert (peek my_queue == 1) diff --git a/ulib/FStar.Queue.fst b/ulib/FStar.Queue.fst index 0773e8dcd7d..c133174c31e 100644 --- a/ulib/FStar.Queue.fst +++ b/ulib/FStar.Queue.fst @@ -30,7 +30,7 @@ let queue_of_seq #a s = queue_of_list (seq_to_list s) (* write comment *) -let eq #a q1 q2 = queue_to_seq q1 == queue_to_seq q2 +let equal #a q1 q2 = queue_to_seq q1 == queue_to_seq q2 (* write comment *) let lemma_eq_intro #_ q1 q2 = () @@ -45,7 +45,7 @@ let lemma_list_queue_bij (#a:Type) (l:list a) | _ -> L.append_l_nil l let lemma_queue_list_bij (#a:Type) (q:queue a) - : Lemma (eq (queue_of_list (queue_to_list q)) q) + : Lemma (equal (queue_of_list (queue_to_list q)) q) = match fst q with | [] -> () | l -> ( @@ -61,7 +61,7 @@ let lemma_seq_queue_bij (#a:Type) (s:seq a) (* write comment *) let lemma_queue_seq_bij (#a:Type) (q:queue a) - : Lemma (eq (queue_of_seq (queue_to_seq q)) q) + : Lemma (equal (queue_of_seq (queue_to_seq q)) q) = let l = (queue_to_list q) in lemma_queue_list_bij q; lemma_list_seq_bij l @@ -150,7 +150,7 @@ let lemma_cons_list_seq (#a:Type) (x:a) (q:queue a) let lemma_dequeue_ok (#a:Type) (q:queue a{not_empty q}) : Lemma (let hd, tl = dequeue q in hd == Seq.head (queue_to_seq q) /\ - eq tl (queue_of_seq (Seq.tail (queue_to_seq q)))) + equal tl (queue_of_seq (Seq.tail (queue_to_seq q)))) = lemma_dequeue_ok_list q; lemma_cons_list_seq (fst (dequeue q)) (snd (dequeue q)) diff --git a/ulib/FStar.Queue.fsti b/ulib/FStar.Queue.fsti index 4a63e14bd11..2241cfe27ec 100644 --- a/ulib/FStar.Queue.fsti +++ b/ulib/FStar.Queue.fsti @@ -10,7 +10,7 @@ val queue_to_seq (#a:Type) (q:queue a) : seq a val queue_of_seq (#a:Type) (s:seq a) : queue a -val eq (#a:Type) (q1 q2:queue a) : prop +val equal (#a:Type) (q1 q2:queue a) : prop let not_empty (#a:Type) (q:queue a) : prop = let s = queue_to_seq q in @@ -18,20 +18,20 @@ let not_empty (#a:Type) (q:queue a) : prop val lemma_eq_intro: #a:Type -> q1:queue a -> q2:queue a -> Lemma (requires Seq.equal (queue_to_seq q1) (queue_to_seq q2)) - (ensures (eq q1 q2)) - [SMTPat (eq q1 q2)] + (ensures (equal q1 q2)) + [SMTPat (equal q1 q2)] val lemma_eq_elim: #a:Type -> q1:queue a -> q2:queue a -> Lemma - (requires (eq q1 q2)) + (requires (equal q1 q2)) (ensures queue_to_seq q1 == queue_to_seq q2) - [SMTPat (eq q1 q2)] + [SMTPat (equal q1 q2)] val lemma_seq_queue_bij: #a:Type -> s:seq a -> Lemma (queue_to_seq (queue_of_seq s) == s) [SMTPat (queue_of_seq s)] val lemma_queue_seq_bij: #a:Type -> q:queue a -> Lemma - (eq (queue_of_seq (queue_to_seq q)) q) + (equal (queue_of_seq (queue_to_seq q)) q) [SMTPat (queue_to_seq q)] val enqueue (#a:Type) (x:a) (q:queue a) : queue a @@ -51,7 +51,7 @@ val lemma_enqueue_ok: #a:Type -> x:a -> q:queue a -> Lemma val lemma_dequeue_ok: #a:Type -> q:queue a{not_empty q} -> Lemma (let hd, tl = dequeue q in hd == Seq.head (queue_to_seq q) /\ - eq tl (queue_of_seq (Seq.tail (queue_to_seq q)))) + equal tl (queue_of_seq (Seq.tail (queue_to_seq q)))) [SMTPat (dequeue q)] val lemma_peek_ok: #a:Type -> q:queue a{not_empty q} -> Lemma From 910d340ab20985691fd527563207bb68aa31d6a1 Mon Sep 17 00:00:00 2001 From: meganfrisella Date: Fri, 9 Jun 2023 12:34:54 -0700 Subject: [PATCH 009/239] finish queue proofs --- ulib/FStar.Queue.fst | 46 +++++++++++++++++++------------------------- 1 file changed, 20 insertions(+), 26 deletions(-) diff --git a/ulib/FStar.Queue.fst b/ulib/FStar.Queue.fst index c133174c31e..7799dcaecff 100644 --- a/ulib/FStar.Queue.fst +++ b/ulib/FStar.Queue.fst @@ -66,10 +66,6 @@ let lemma_queue_seq_bij (#a:Type) (q:queue a) lemma_queue_list_bij q; lemma_list_seq_bij l -let lemma_seq_to_list_empty (#a:Type) (s:seq a) - : Lemma (s == Seq.empty ==> seq_to_list s == []) - = lemma_list_seq_bij (seq_to_list s) - (* write comment *) let enqueue (#a:Type) (x:a) (q:queue a) : queue a @@ -80,7 +76,7 @@ let enqueue (#a:Type) (x:a) (q:queue a) (* write comment *) let dequeue (#a:Type) (q:queue a{not_empty q}) : a & queue a - = lemma_seq_to_list_empty (queue_to_seq q); + = lemma_seq_of_list_induction (queue_to_list q); let hd :: tl = fst q in match tl with | [] -> hd, (L.rev (snd q), []) @@ -89,7 +85,7 @@ let dequeue (#a:Type) (q:queue a{not_empty q}) (* write comment *) let peek (#a:Type) (q:queue a{not_empty q}) : a - = lemma_seq_to_list_empty (queue_to_seq q); + = lemma_seq_of_list_induction (queue_to_list q); L.hd (fst q) (* write comment *) @@ -106,20 +102,23 @@ let lemma_enqueue_ok_list (#a:Type) (x:a) (q:queue a) L.rev_append [x] (snd q) ) -let lemma_seq_to_list_dist_append (#a:Type) (s1 s2:seq a) - : Lemma (seq_to_list (Seq.append s1 s2) == L.append (seq_to_list s1) (seq_to_list s2)) - = admit() - -let lemma_snoc_seq_list (#a:Type) (x:a) (q:queue a) - : Lemma (L.snoc ((queue_to_list q),x) == (seq_to_list (Seq.snoc (queue_to_seq q) x))) - = let l = (queue_to_list q) in - lemma_seq_to_list_dist_append (seq_of_list l) (Seq.create 1 x); - lemma_list_seq_bij l +let rec lemma_append_seq_of_list_dist (#a:Type) (l1 l2:list a) + : Lemma (ensures Seq.equal (seq_of_list (L.append l1 l2)) (Seq.append (seq_of_list l1) (seq_of_list l2))) + = match l1 with + | [] -> L.append_nil_l l2 + | hd :: tl -> + ( + lemma_seq_of_list_induction (hd :: (L.append tl l2)); + lemma_append_seq_of_list_dist tl l2; + Seq.append_cons hd (seq_of_list tl) (seq_of_list l2); + lemma_seq_of_list_induction (hd :: tl) + ) let lemma_snoc_list_seq (#a:Type) (x:a) (q:queue a) : Lemma (seq_of_list (L.snoc ((queue_to_list q),x)) == Seq.snoc (queue_to_seq q) x) - = lemma_snoc_seq_list x q; - lemma_seq_list_bij (Seq.snoc (queue_to_seq q) x) + = let l = (queue_to_list q) in + lemma_append_seq_of_list_dist l [x]; + lemma_seq_list_bij (Seq.create 1 x) (* write comment *) let lemma_enqueue_ok (#a:Type) (x:a) (q:queue a) @@ -129,22 +128,17 @@ let lemma_enqueue_ok (#a:Type) (x:a) (q:queue a) let lemma_dequeue_ok_list (#a:Type) (q:queue a{not_empty q}) : Lemma (fst (dequeue q) :: queue_to_list (snd (dequeue q)) == queue_to_list q) - = lemma_seq_to_list_empty (queue_to_seq q); + = lemma_seq_of_list_induction (queue_to_list q); let hd :: tl = fst q in match tl with | [] -> L.append_l_nil (L.rev (snd q)) | _ -> L.append_assoc [hd] tl (L.rev (snd q)) - -let lemma_cons_seq_list (#a:Type) (x:a) (q:queue a) - : Lemma (x :: (queue_to_list q) == seq_to_list (Seq.cons x (queue_to_seq q))) - = let l = (queue_to_list q) in - lemma_seq_to_list_dist_append (Seq.create 1 x) (seq_of_list l); - lemma_list_seq_bij l let lemma_cons_list_seq (#a:Type) (x:a) (q:queue a) : Lemma (seq_of_list (x :: (queue_to_list q)) == Seq.cons x (queue_to_seq q)) - = lemma_cons_seq_list x q; - lemma_seq_list_bij (Seq.cons x (queue_to_seq q)) + = let l = (queue_to_list q) in + lemma_append_seq_of_list_dist [x] l; + lemma_seq_list_bij (Seq.create 1 x) (* write comment *) let lemma_dequeue_ok (#a:Type) (q:queue a{not_empty q}) From ead4864de8f4425a19b6c45dc8917f4a91a34598 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Tue, 26 Mar 2024 11:27:44 -0700 Subject: [PATCH 010/239] restrict injectivity of inductives based on a simpler but more restrictive check --- .../generated/FStar_SMTEncoding_Encode.ml | 19 +------------------ src/smtencoding/FStar.SMTEncoding.Encode.fst | 9 +++++---- 2 files changed, 6 insertions(+), 22 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index 74187ca1445..66443a1be87 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -4632,24 +4632,7 @@ and (encode_sigelt' : let t_tp = (tp.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in let uu___10 = u_leq_u_k u_tp in - if uu___10 - then true - else - (let uu___12 = - FStar_Syntax_Util.arrow_formals - t_tp in - match uu___12 with - | (formals, uu___13) -> - let uu___14 = - FStar_TypeChecker_TcTerm.tc_binders - env_tps formals in - (match uu___14 with - | (uu___15, uu___16, uu___17, - u_formals) -> - FStar_Compiler_Util.for_all - (fun u_formal -> - u_leq_u_k u_formal) - u_formals)) in + if uu___10 then true else false in FStar_Compiler_List.forall2 tp_ok tps3 us)))) in ((let uu___4 = diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index 47f762e1787..642346e63fe 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -1273,10 +1273,11 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = let t_tp = tp.binder_bv.sort in if u_leq_u_k u_tp then true - else let formals, _ = U.arrow_formals t_tp in - let _, _, _, u_formals = TcTerm.tc_binders env_tps formals in - //List.iter (fun u -> BU.print1 "Universe of formal: %s\n" (Print.univ_to_string u)) u_formals; - BU.for_all (fun u_formal -> u_leq_u_k u_formal) u_formals + else false + // let formals, _ = U.arrow_formals t_tp in + // let _, _, _, u_formals = TcTerm.tc_binders env_tps formals in + // //List.iter (fun u -> BU.print1 "Universe of formal: %s\n" (Print.univ_to_string u)) u_formals; + // BU.for_all (fun u_formal -> u_leq_u_k u_formal) u_formals in List.forall2 tp_ok tps us in From 2c50dcdee0c7bcfd500073e296debbaa5dbe13b2 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Tue, 26 Mar 2024 22:52:57 -0700 Subject: [PATCH 011/239] a refinement of the injectivity constraint --- .../generated/FStar_SMTEncoding_Encode.ml | 50 +++++++++++++++++-- src/smtencoding/FStar.SMTEncoding.Encode.fst | 38 +++++++++++--- ulib/FStar.ModifiesGen.fst | 15 ++++-- ulib/FStar.WellFounded.Util.fst | 4 +- ulib/FStar.WellFounded.fst | 25 ++++++++-- ulib/FStar.WellFoundedRelation.fst | 9 +++- ulib/legacy/FStar.Constructive.fst | 5 +- 7 files changed, 122 insertions(+), 24 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index 66443a1be87..35d0d0218db 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -4491,6 +4491,7 @@ and (encode_sigelt' : FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___2; FStar_Syntax_Syntax.ds = datas;_} -> + let t_lid = t in let tcenv = env.FStar_SMTEncoding_Env.tcenv in let is_injective = let uu___3 = FStar_Syntax_Subst.univ_var_opening universe_names in @@ -4624,15 +4625,58 @@ and (encode_sigelt' : uu___12 | uu___10 -> false in let u_leq_u_k u = - let uu___10 = + let u1 = FStar_TypeChecker_Normalize.normalize_universe env_tps u in - universe_leq uu___10 u_k in + universe_leq u1 u_k in let tp_ok tp u_tp = let t_tp = (tp.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in let uu___10 = u_leq_u_k u_tp in - if uu___10 then true else false in + if uu___10 + then true + else + (let t_tp1 = + FStar_TypeChecker_Normalize.normalize + [FStar_TypeChecker_Env.Unrefine; + FStar_TypeChecker_Env.Unascribe; + FStar_TypeChecker_Env.Unmeta; + FStar_TypeChecker_Env.Primops; + FStar_TypeChecker_Env.HNF; + FStar_TypeChecker_Env.UnfoldUntil + FStar_Syntax_Syntax.delta_constant; + FStar_TypeChecker_Env.Beta] + env_tps t_tp in + let uu___12 = + FStar_Syntax_Util.arrow_formals + t_tp1 in + match uu___12 with + | (formals, t1) -> + let uu___13 = + FStar_TypeChecker_TcTerm.tc_binders + env_tps formals in + (match uu___13 with + | (uu___14, uu___15, uu___16, + u_formals) -> + let inj = + FStar_Compiler_Util.for_all + (fun u_formal -> + u_leq_u_k u_formal) + u_formals in + if inj + then + let uu___17 = + let uu___18 = + FStar_Syntax_Subst.compress + t1 in + uu___18.FStar_Syntax_Syntax.n in + (match uu___17 with + | FStar_Syntax_Syntax.Tm_type + uu___18 -> true + | FStar_Syntax_Syntax.Tm_name + uu___18 -> true + | uu___18 -> false) + else false)) in FStar_Compiler_List.forall2 tp_ok tps3 us)))) in ((let uu___4 = diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index 642346e63fe..5bc47758a5f 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -1228,6 +1228,7 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = params=tps; t=k; ds=datas} -> + let t_lid = t in let tcenv = env.tcenv in let is_injective = let usubst, uvs = SS.univ_var_opening universe_names in @@ -1267,17 +1268,42 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = | _ -> false in let u_leq_u_k u = - universe_leq (N.normalize_universe env_tps u) u_k + let u = N.normalize_universe env_tps u in + universe_leq u u_k in let tp_ok (tp:S.binder) (u_tp:universe) = let t_tp = tp.binder_bv.sort in if u_leq_u_k u_tp then true - else false - // let formals, _ = U.arrow_formals t_tp in - // let _, _, _, u_formals = TcTerm.tc_binders env_tps formals in - // //List.iter (fun u -> BU.print1 "Universe of formal: %s\n" (Print.univ_to_string u)) u_formals; - // BU.for_all (fun u_formal -> u_leq_u_k u_formal) u_formals + else ( + let t_tp = + N.normalize + [Unrefine; Unascribe; Unmeta; + Primops; HNF; UnfoldUntil delta_constant; Beta] + env_tps t_tp + in + let formals, t = U.arrow_formals t_tp in + let _, _, _, u_formals = TcTerm.tc_binders env_tps formals in + let inj = BU.for_all (fun u_formal -> u_leq_u_k u_formal) u_formals in + if inj + then ( + match (SS.compress t).n with + | Tm_type _ -> (* this parameter is an "arity", i.e., a type function *) + true + | Tm_name _ -> (* this is a value of another type parameter in scope *) + true + | _ -> + // BU.print5 "No injectivity for %s because of parameter %s : %s @ universe %s GSet.mem (ALoc x.region x.addr (if None? x.loc then None else Some (make_cls_union_aloc b (Some?.v x.loc)))) (union_aux_of_aux_left c b aux)) [SMTPat (GSet.mem x aux)] -= () += let ALoc _ _ _ = x in () let mem_union_aux_of_aux_left_elim (#al: (bool -> HS.rid -> nat -> Tot Type)) @@ -2118,12 +2122,12 @@ let upgrade_aloc (#al: aloc_t u#a) (#c: cls al) (a: aloc c) : Tot (aloc (raise_c let downgrade_aloc_upgrade_aloc (#al: aloc_t u#a) (#c: cls al) (a: aloc c) : Lemma (downgrade_aloc (upgrade_aloc u#a u#b a) == a) [SMTPat (downgrade_aloc (upgrade_aloc u#a u#b a))] -= () += let ALoc _ _ _ = a in () let upgrade_aloc_downgrade_aloc (#al: aloc_t u#a) (#c: cls al) (a: aloc (raise_cls u#a u#b c)) : Lemma (upgrade_aloc (downgrade_aloc a) == a) [SMTPat (upgrade_aloc u#a u#b (downgrade_aloc a))] -= () += let ALoc _ _ _ = a in () let raise_loc_aux_pred (#al: aloc_t u#a) @@ -2166,6 +2170,7 @@ let raise_loc_includes #al #c l1 l2 = #pop-options let raise_loc_disjoint #al #c l1 l2 = + // let ALoc _ _ _ = al in let l1' = raise_loc l1 in let l2' = raise_loc l2 in assert (forall (x: aloc (raise_cls c)) . GSet.mem x (Ghost.reveal (Loc?.aux l1')) <==> GSet.mem (downgrade_aloc x) (Ghost.reveal (Loc?.aux l1))); diff --git a/ulib/FStar.WellFounded.Util.fst b/ulib/FStar.WellFounded.Util.fst index a738123731b..a4fc7cdf1e2 100644 --- a/ulib/FStar.WellFounded.Util.fst +++ b/ulib/FStar.WellFounded.Util.fst @@ -52,7 +52,7 @@ let lift_binrel_well_founded (#a:Type u#a) : Tot (acc (lift_binrel r) y) (decreases pf) = AccIntro (fun (z:top) (p:lift_binrel r z y) -> - aux z (pf.access_smaller (dsnd z) (lower_binrel z y p))) + aux z (match pf with | AccIntro access_smaller -> access_smaller (dsnd z) (lower_binrel z y p))) in let aux' (y:top{dfst y =!= a}) : acc (lift_binrel r) y @@ -83,7 +83,7 @@ let lift_binrel_squashed_well_founded (#a:Type u#a) (decreases pf) = AccIntro (fun (z:top) (p:lift_binrel_squashed r z y) -> let p = lower_binrel_squashed z y p in - aux z (pf.access_smaller (dsnd z) (FStar.Squash.join_squash p))) + aux z (match pf with AccIntro access_smaller -> access_smaller (dsnd z) (FStar.Squash.join_squash p))) in let aux' (y:top{dfst y =!= a}) : acc (lift_binrel_squashed r) y diff --git a/ulib/FStar.WellFounded.fst b/ulib/FStar.WellFounded.fst index 97ee6223a4b..639ea3324dd 100644 --- a/ulib/FStar.WellFounded.fst +++ b/ulib/FStar.WellFounded.fst @@ -50,7 +50,13 @@ let rec fix_F (#aa:Type) (#r:binrel aa) (#p:(aa -> Type)) (f: (x:aa -> (y:aa -> r y x -> p y) -> p x)) (x:aa) (a:acc r x) : Tot (p x) (decreases a) - = f x (fun y h -> fix_F f y (a.access_smaller y h)) + = f x (fun y h -> + let v : acc r y = + match a with + | AccIntro access_smaller -> + access_smaller y h + in + fix_F f y v) let fix (#aa:Type) (#r:binrel aa) (rwf:well_founded r) (p:aa -> Type) (f:(x:aa -> (y:aa -> r y x -> p y) -> p x)) @@ -101,9 +107,12 @@ let subrelation_squash_wf (#a:Type u#a) let rec acc_y (x:a) (acc_r:acc r x) (y:a) (p:sub_r y x) : Tot (acc sub_r y) (decreases acc_r) - = AccIntro (acc_y y (acc_r.access_smaller - y - (elim_squash (sub_w y x p)))) + = let v : acc _ y = + match acc_r with + | AccIntro access_smaller -> + access_smaller y (elim_squash (sub_w y x p)) + in + AccIntro (acc_y y v) in FStar.Squash.return_squash (FStar.Squash.return_squash (AccIntro (acc_y x (r_wf x)))) ) @@ -126,6 +135,12 @@ let inverse_image_wf (#a:Type u#a) (#b:Type u#b) (#r_b:binrel u#b u#r b) = let rec aux (x:a) (acc_r_b:acc r_b (f x)) : Tot (acc (inverse_image r_b f) x) (decreases acc_r_b) = - AccIntro (fun y p -> aux y (acc_r_b.access_smaller (f y) p)) + AccIntro (fun y p -> + let v = + match acc_r_b with + | AccIntro access_smaller -> + access_smaller (f y) p + in + aux y v) in fun x -> aux x (r_b_wf (f x)) diff --git a/ulib/FStar.WellFoundedRelation.fst b/ulib/FStar.WellFoundedRelation.fst index 3460dfb52f3..ea8f6217d86 100644 --- a/ulib/FStar.WellFoundedRelation.fst +++ b/ulib/FStar.WellFoundedRelation.fst @@ -62,7 +62,14 @@ let rec acc_decreaser let smaller (y: a{(acc_relation r) y x}) : (acc_classical (acc_relation r) y) = ( eliminate exists (p: r y x). True returns f y << f x - with _. assert ((f x).access_smaller y p == f y); + with _. assert ( + let v = + match f x with + | WF.AccIntro access_smaller -> + access_smaller y p + in + v == f y + ); acc_decreaser r f y ) in AccClassicalIntro smaller diff --git a/ulib/legacy/FStar.Constructive.fst b/ulib/legacy/FStar.Constructive.fst index 249b52e6ca8..7a50cb8ba8d 100644 --- a/ulib/legacy/FStar.Constructive.fst +++ b/ulib/legacy/FStar.Constructive.fst @@ -14,6 +14,7 @@ limitations under the License. *) module FStar.Constructive + type cand p1 p2 = | Conj : h1:p1 -> h2:p2 -> cand p1 p2 @@ -39,10 +40,10 @@ type ceq_type (a:Type) : Type -> Type = | ReflType : ceq_type a a val eq_ind : #a:Type -> x:a -> p:(a -> Type) -> f:p x -> y:a -> e:ceq x y -> Tot (p y) -let eq_ind #a x p f y _ = f +let eq_ind #a x p f y e = let Refl = e in f val ceq_eq : #a:Type{hasEq a} -> #x:a -> #y:a -> h:(ceq x y) -> Lemma (x = y) -let ceq_eq #a #x #y h = () +let ceq_eq #a #x #y h = let Refl = h in () val ceq_congruence : #a:Type -> #b:Type -> #x:a -> #y:a -> ceq x y -> f:(a -> GTot b) -> GTot (ceq (f x) (f y)) From 92f768a28fd33b02a20ef19e30d46256be50bb5d Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Wed, 27 Mar 2024 11:50:08 -0700 Subject: [PATCH 012/239] retain equations on indices even if parameters are in a universe too high; dd support for --ext 'compat:injectivity' for assisting with breakages --- .../generated/FStar_SMTEncoding_Encode.ml | 56 ++++++++++++++++--- src/smtencoding/FStar.SMTEncoding.Encode.fst | 16 ++++-- 2 files changed, 60 insertions(+), 12 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index 35d0d0218db..3a3fd75033a 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -4493,7 +4493,7 @@ and (encode_sigelt' : -> let t_lid = t in let tcenv = env.FStar_SMTEncoding_Env.tcenv in - let is_injective = + let is_injective_on_params = let uu___3 = FStar_Syntax_Subst.univ_var_opening universe_names in match uu___3 with | (usubst, uvs) -> @@ -4686,7 +4686,7 @@ and (encode_sigelt' : then let uu___5 = FStar_Ident.string_of_lid t in FStar_Compiler_Util.print2 "%s injectivity for %s\n" - (if is_injective then "YES" else "NO") uu___5 + (if is_injective_on_params then "YES" else "NO") uu___5 else ()); (let quals = se.FStar_Syntax_Syntax.sigquals in let is_logical = @@ -4794,21 +4794,61 @@ and (encode_sigelt' : "Impossible" else (); (let eqs = - if is_injective + let uu___14 = + is_injective_on_params + || + (let uu___15 = + FStar_Options.ext_getv + "compat:injectivity" in + uu___15 <> "") in + if uu___14 then FStar_Compiler_List.map2 (fun v -> fun a -> - let uu___14 = - let uu___15 + let uu___15 = + let uu___16 = FStar_SMTEncoding_Util.mkFreeV v in - (uu___15, a) in + (uu___16, a) in FStar_SMTEncoding_Util.mkEq - uu___14) + uu___15) vars indices1 - else [] in + else + (let num_params = + FStar_Compiler_List.length + tps in + let uu___16 = + FStar_Compiler_List.splitAt + num_params vars in + match uu___16 with + | (_var_params, + var_indices) -> + let uu___17 = + FStar_Compiler_List.splitAt + num_params + indices1 in + (match uu___17 + with + | (_i_params, + indices2) -> + FStar_Compiler_List.map2 + ( + fun v -> + fun a -> + let uu___18 + = + let uu___19 + = + FStar_SMTEncoding_Util.mkFreeV + v in + (uu___19, + a) in + FStar_SMTEncoding_Util.mkEq + uu___18) + var_indices + indices2)) in let uu___14 = let uu___15 = let uu___16 = diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index 5bc47758a5f..238058ea5d6 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -1230,7 +1230,7 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = ds=datas} -> let t_lid = t in let tcenv = env.tcenv in - let is_injective = + let is_injective_on_params = let usubst, uvs = SS.univ_var_opening universe_names in let env, tps, k = Env.push_univ_vars tcenv uvs, @@ -1309,7 +1309,7 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = in if Env.debug env.tcenv <| Options.Other "SMTEncoding" then BU.print2 "%s injectivity for %s\n" - (if is_injective then "YES" else "NO") + (if is_injective_on_params then "YES" else "NO") (Ident.string_of_lid t); let quals = se.sigquals in let is_logical = quals |> BU.for_some (function Logic | Assumption -> true | _ -> false) in @@ -1333,9 +1333,17 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = if List.length indices <> List.length vars then failwith "Impossible"; let eqs = - if is_injective + if is_injective_on_params + || Options.ext_getv "compat:injectivity" <> "" then List.map2 (fun v a -> mkEq(mkFreeV v, a)) vars indices - else [] in + else ( + //only injectivity on indices + let num_params = List.length tps in + let _var_params, var_indices = List.splitAt num_params vars in + let _i_params, indices = List.splitAt num_params indices in + List.map2 (fun v a -> mkEq(mkFreeV v, a)) var_indices indices + ) + in mkOr(out, mkAnd(mk_data_tester env l xx, eqs |> mk_and_l)), decls@decls') (mkFalse, []) in let ffsym, ff = fresh_fvar env.current_module_name "f" Fuel_sort in let fuel_guarded_inversion = From fb34777cecf5ade03ab0d3209adb1a18000b7760 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Mon, 15 Apr 2024 17:02:10 -0700 Subject: [PATCH 013/239] restrict the universe of type-function parameters when enabling injectivity --- .../generated/FStar_SMTEncoding_Encode.ml | 53 ++++++++++++-- src/smtencoding/FStar.SMTEncoding.Encode.fst | 18 ++--- tests/bug-reports/BugBoxInjectivity.fst | 72 +++++++++++++++++++ 3 files changed, 130 insertions(+), 13 deletions(-) create mode 100644 tests/bug-reports/BugBoxInjectivity.fst diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index c69be924340..b46d457c17f 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -4672,11 +4672,56 @@ and (encode_sigelt' : uu___18.FStar_Syntax_Syntax.n in (match uu___17 with | FStar_Syntax_Syntax.Tm_type - uu___18 -> true + u -> u_leq_u_k u | FStar_Syntax_Syntax.Tm_name - uu___18 -> true - | uu___18 -> false) - else false)) in + uu___18 -> + ((let uu___20 = + FStar_Syntax_Print.binder_to_string + tp in + let uu___21 = + FStar_Syntax_Print.term_to_string + t_tp1 in + FStar_Compiler_Util.print2 + "Retaining injectivity for name parameter %s : %s\n" + uu___20 uu___21); + true) + | uu___18 -> + ((let uu___20 = + FStar_Ident.string_of_lid + t_lid in + let uu___21 = + FStar_Syntax_Print.binder_to_string + tp in + let uu___22 = + FStar_Syntax_Print.term_to_string + t_tp1 in + let uu___23 = + let uu___24 = + FStar_TypeChecker_Normalize.normalize_universe + env_tps + u_tp in + FStar_Syntax_Print.univ_to_string + uu___24 in + let uu___24 = + FStar_Syntax_Print.univ_to_string + u_k in + FStar_Compiler_Util.print5 + "No injectivity for %s because of parameter %s : %s @ universe %s (* this parameter is an "arity", i.e., a type function *) - true + | Tm_type u -> + (* retain injectivity for parameters that are type functions + from small universes (i.e., all formals are smaller than the constructed type) + to a universe <= the universe of the constructed type. + See BugBoxInjectivity.fst *) + u_leq_u_k u | Tm_name _ -> (* this is a value of another type parameter in scope *) true | _ -> - // BU.print5 "No injectivity for %s because of parameter %s : %s @ universe %s Type u#1) : Type u#1 = + | Mk : test a + +let const (f:Type u#1) : Type u#0 -> Type u#1 = fun _ -> f +let itest (f:Type u#1) : Type u#1 = test (const f) +let itest_inhabited (f:Type u#1) : itest f = Mk +let const_inversion (f0 f1:Type u#1) +: Lemma + (requires const f0 == const f1) + (ensures f0 == f1) += let _f0 = const f0 int in + let _f1 = const f1 int in + assert (_f0 == _f1); + () +let itest_injective (f0 f1:Type u#1) +: Lemma + (ensures itest f0 == itest f1 ==> const f0 == const f1) += let x : test (const f0) = itest_inhabited f0 in + let Mk #_ = x in + () +open FStar.Functions +let itest_injective' : squash (is_inj itest) = + introduce forall f0 f1. + itest f0 == itest f1 ==> f0 == f1 + with introduce _ ==> _ + with _ . ( + itest_injective f0 f1; + const_inversion f0 f1 + ) +[@@expect_failure [189]] //itest is not in the right universe to use this lemma +let fals : squash False = + CC.no_inj_universes itest + + +#push-options "--ext 'compat:injectivity'" +noeq +type test2 (a:Type u#0 -> Type u#2) : Type u#1 = + | Mk2 : test2 a +#pop-options +let const2 (f:Type u#2) : Type u#0 -> Type u#2 = fun _ -> f +let itest2 (f:Type u#2) : Type u#1 = test2 (const2 f) +let itest2_inhabited (f:Type u#2) : itest2 f = Mk2 +let const2_inversion (f0 f1:Type u#2) +: Lemma + (requires const2 f0 == const2 f1) + (ensures f0 == f1) += let _f0 = const2 f0 (FStar.Universe.raise_t int) in + let _f1 = const2 f1 (FStar.Universe.raise_t int) in + assert (_f0 == _f1); + () +let itest2_injective (f0 f1:Type u#2) +: Lemma + (ensures itest2 f0 == itest2 f1 ==> const2 f0 == const2 f1) += let x : test2 (const2 f0) = itest2_inhabited f0 in + let Mk2 #_ = x in + () +open FStar.Functions +let itest2_injective' : squash (is_inj itest2) = + introduce forall f0 f1. + itest2 f0 == itest2 f1 ==> f0 == f1 + with introduce _ ==> _ + with _ . ( + itest2_injective f0 f1; + const2_inversion f0 f1 + ) +let fals () : squash False = + CC.no_inj_universes itest2 \ No newline at end of file From 773cdc39cfda1eef546179989f41c2ffc1b439f0 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Mon, 15 Apr 2024 17:02:42 -0700 Subject: [PATCH 014/239] snap --- .../generated/FStar_SMTEncoding_Encode.ml | 51 ++----------------- 1 file changed, 3 insertions(+), 48 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index b46d457c17f..36f8ff0e76f 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -4674,54 +4674,9 @@ and (encode_sigelt' : | FStar_Syntax_Syntax.Tm_type u -> u_leq_u_k u | FStar_Syntax_Syntax.Tm_name - uu___18 -> - ((let uu___20 = - FStar_Syntax_Print.binder_to_string - tp in - let uu___21 = - FStar_Syntax_Print.term_to_string - t_tp1 in - FStar_Compiler_Util.print2 - "Retaining injectivity for name parameter %s : %s\n" - uu___20 uu___21); - true) - | uu___18 -> - ((let uu___20 = - FStar_Ident.string_of_lid - t_lid in - let uu___21 = - FStar_Syntax_Print.binder_to_string - tp in - let uu___22 = - FStar_Syntax_Print.term_to_string - t_tp1 in - let uu___23 = - let uu___24 = - FStar_TypeChecker_Normalize.normalize_universe - env_tps - u_tp in - FStar_Syntax_Print.univ_to_string - uu___24 in - let uu___24 = - FStar_Syntax_Print.univ_to_string - u_k in - FStar_Compiler_Util.print5 - "No injectivity for %s because of parameter %s : %s @ universe %s true + | uu___18 -> false) + else false)) in FStar_Compiler_List.forall2 tp_ok tps3 us)))) in ((let uu___4 = From df6fb0d52e52289db625cbdbc7c34d975801d819 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Mon, 15 Apr 2024 17:47:42 -0700 Subject: [PATCH 015/239] need to explicitly destruct Refl --- ulib/legacy/FStar.Constructive.fst | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/ulib/legacy/FStar.Constructive.fst b/ulib/legacy/FStar.Constructive.fst index 7a50cb8ba8d..55dc7bbd980 100644 --- a/ulib/legacy/FStar.Constructive.fst +++ b/ulib/legacy/FStar.Constructive.fst @@ -47,13 +47,15 @@ let ceq_eq #a #x #y h = let Refl = h in () val ceq_congruence : #a:Type -> #b:Type -> #x:a -> #y:a -> ceq x y -> f:(a -> GTot b) -> GTot (ceq (f x) (f y)) -let ceq_congruence #a #b #x #y h f = Refl #_ #(f x) //refuse to infer terms with non-Tot effect +let ceq_congruence #a #b #x #y h f = + let Refl = h in + Refl #_ #(f x) //refuse to infer terms with non-Tot effect val ceq_symm : #a:Type -> #x:a -> #y:a -> ceq x y -> Tot (ceq y x) -let ceq_symm #a #x #y h = Refl +let ceq_symm #a #x #y h = let Refl = h in Refl val ceq_trans : #a:Type -> #x:a -> #y:a -> #z:a -> ceq x y -> ceq y z -> Tot (ceq x z) -let ceq_trans #a #x #y #z hxy hyz = Refl +let ceq_trans #a #x #y #z hxy hyz = let Refl = hxy in let Refl = hyz in Refl type ctrue = | I : ctrue From 13cb2d3c3c51fbfc1a17880576a41039f55f79ea Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Mon, 15 Apr 2024 18:05:48 -0700 Subject: [PATCH 016/239] another explicit Refl destruction --- tests/bug-reports/Bug3186.fst | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/tests/bug-reports/Bug3186.fst b/tests/bug-reports/Bug3186.fst index 4ce06ae1a4d..544473db34a 100644 --- a/tests/bug-reports/Bug3186.fst +++ b/tests/bug-reports/Bug3186.fst @@ -3,7 +3,14 @@ module Bug3186 let base (x:int) (_: unit {equals x 0}) = assert (x == 0) -let base2 (x:int) (_: equals x 0) = +let base2 (x:int) (hyp: equals x 0) = + let Refl = hyp in + assert (x == 0) + + //fails since the inversion on equals is not strong enough + //to be usable directly, since df6fb0d52e52289db625cbdbc7c34d975801d819 +[@@expect_failure [19]] +let base2' (x:int) (hyp: equals x 0) = assert (x == 0) [@@expect_failure [19]] From 3a4b5186e5cb4f0d125ed6f627bc3d9c2d52a003 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Mon, 15 Apr 2024 21:01:02 -0700 Subject: [PATCH 017/239] snap --- .../fstar-lib/generated/FStar_InteractiveHelpers_Effectful.ml | 2 +- .../generated/FStar_InteractiveHelpers_ExploreTerm.ml | 2 +- ocaml/fstar-lib/generated/FStar_Reflection_V2_Formula.ml | 2 +- ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml | 4 ++-- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_InteractiveHelpers_Effectful.ml b/ocaml/fstar-lib/generated/FStar_InteractiveHelpers_Effectful.ml index fc4f80aa92c..8abdb5a53e0 100644 --- a/ocaml/fstar-lib/generated/FStar_InteractiveHelpers_Effectful.ml +++ b/ocaml/fstar-lib/generated/FStar_InteractiveHelpers_Effectful.ml @@ -1676,7 +1676,7 @@ let (compute_eterm_info : (Obj.repr (FStar_InteractiveHelpers_Base.mfail_doc (FStar_List_Tot_Base.op_At - [FStar_Errors_Msg.text + [FStar_Pprint.arbitrary_string "compute_eterm_info: failure"] msg))) | e1 -> diff --git a/ocaml/fstar-lib/generated/FStar_InteractiveHelpers_ExploreTerm.ml b/ocaml/fstar-lib/generated/FStar_InteractiveHelpers_ExploreTerm.ml index f9e8d468089..f12d76e5caf 100644 --- a/ocaml/fstar-lib/generated/FStar_InteractiveHelpers_ExploreTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_InteractiveHelpers_ExploreTerm.ml @@ -1820,7 +1820,7 @@ let rec (inst_comp : (Obj.repr (FStar_InteractiveHelpers_Base.mfail_doc (FStar_List_Tot_Base.op_At - [FStar_Errors_Msg.text + [FStar_Pprint.arbitrary_string "inst_comp: error"] msg))) | err -> diff --git a/ocaml/fstar-lib/generated/FStar_Reflection_V2_Formula.ml b/ocaml/fstar-lib/generated/FStar_Reflection_V2_Formula.ml index 9e81e052229..e166c0ab4f1 100644 --- a/ocaml/fstar-lib/generated/FStar_Reflection_V2_Formula.ml +++ b/ocaml/fstar-lib/generated/FStar_Reflection_V2_Formula.ml @@ -986,7 +986,7 @@ let (term_as_formula' : (Obj.repr (FStar_Tactics_Effect.raise (FStar_Tactics_Common.TacticFailure - (FStar_Errors_Msg.mkmsg "???"))))) uu___) + [FStar_Pprint.arbitrary_string "???"])))) uu___) let _ = FStar_Tactics_Native.register_tactic "FStar.Reflection.V2.Formula.term_as_formula'" (Prims.of_int (2)) diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml index 3a82a0cda51..25c69d85574 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml @@ -1211,7 +1211,7 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one - (FStar_Errors_Msg.text + (FStar_Pprint.arbitrary_string "Could not solve constraint") uu___4)))) (fun @@ -1233,7 +1233,7 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = ( (op_At ()) [ - FStar_Errors_Msg.text + FStar_Pprint.arbitrary_string "Typeclass resolution failed"] msg))) | e -> From 3c60a276d0fb2687e773ba22ee1896250ada7d9d Mon Sep 17 00:00:00 2001 From: Gabriel Ebner Date: Tue, 16 Apr 2024 14:24:14 -0700 Subject: [PATCH 018/239] Do not normalize domains of arrows with HNF. --- .../generated/FStar_TypeChecker_Normalize.ml | 59 +++++++++++++++++-- src/typechecker/FStar.TypeChecker.Env.fsti | 2 +- .../FStar.TypeChecker.Normalize.fst | 19 +++++- tests/tactics/WeakVsHNF.fst | 23 ++++++++ ulib/FStar.Pervasives.fsti | 2 +- 5 files changed, 98 insertions(+), 7 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml index 5b16b2d2068..c8a74568a02 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml @@ -1305,6 +1305,54 @@ let (closure_as_term : FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax) = fun cfg -> fun env1 -> fun t -> non_tail_inline_closure_env cfg env1 t +let (binder_closure_as_term : + FStar_TypeChecker_Cfg.cfg -> + env -> FStar_Syntax_Syntax.binder -> FStar_Syntax_Syntax.binder) + = + fun cfg -> + fun env1 -> + fun b -> + let x = + let uu___ = b.FStar_Syntax_Syntax.binder_bv in + let uu___1 = + closure_as_term cfg env1 + (b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in + { + FStar_Syntax_Syntax.ppname = (uu___.FStar_Syntax_Syntax.ppname); + FStar_Syntax_Syntax.index = (uu___.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = uu___1 + } in + let imp = + match b.FStar_Syntax_Syntax.binder_qual with + | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Meta t) -> + let uu___ = + let uu___1 = closure_as_term cfg env1 t in + FStar_Syntax_Syntax.Meta uu___1 in + FStar_Pervasives_Native.Some uu___ + | i -> i in + let attrs = + FStar_Compiler_List.map (closure_as_term cfg env1) + b.FStar_Syntax_Syntax.binder_attrs in + FStar_Syntax_Syntax.mk_binder_with_attrs x imp + b.FStar_Syntax_Syntax.binder_positivity attrs +let (binders_closure_as_term : + FStar_TypeChecker_Cfg.cfg -> + (FStar_Syntax_Syntax.binder FStar_Pervasives_Native.option * closure) + Prims.list -> + FStar_Syntax_Syntax.binders -> FStar_Syntax_Syntax.binder Prims.list) + = + fun cfg -> + fun env1 -> + fun bs -> + let uu___ = + FStar_Compiler_List.fold_left + (fun uu___1 -> + fun b -> + match uu___1 with + | (nbs', env2) -> + let b1 = binder_closure_as_term cfg env2 b in + ((b1 :: nbs'), (dummy :: env2))) ([], env1) bs in + match uu___ with | (nbs, uu___1) -> FStar_Compiler_List.rev nbs let (unembed_binder_knot : FStar_Syntax_Syntax.binder FStar_Syntax_Embeddings_Base.embedding FStar_Pervasives_Native.option FStar_Compiler_Effect.ref) @@ -3651,9 +3699,12 @@ let rec (norm : (fun env2 -> fun uu___5 -> dummy :: env2) env1 bs1 in norm_comp cfg uu___4 c1 in - let t2 = - let uu___4 = norm_binders cfg env1 bs1 in - FStar_Syntax_Util.arrow uu___4 c2 in + let bs2 = + if + (cfg.FStar_TypeChecker_Cfg.steps).FStar_TypeChecker_Cfg.hnf + then binders_closure_as_term cfg env1 bs1 + else norm_binders cfg env1 bs1 in + let t2 = FStar_Syntax_Util.arrow bs2 c2 in rebuild cfg env1 stack2 t2) | FStar_Syntax_Syntax.Tm_ascribed { FStar_Syntax_Syntax.tm = t11; @@ -9627,7 +9678,7 @@ let (get_n_binders : FStar_Syntax_Syntax.term -> (FStar_Syntax_Syntax.binder Prims.list * FStar_Syntax_Syntax.comp)) = fun env1 -> fun n -> fun t -> get_n_binders' env1 [] n t -let (uu___3790 : unit) = +let (uu___3815 : unit) = FStar_Compiler_Effect.op_Colon_Equals __get_n_binders get_n_binders' let (maybe_unfold_head_fv : FStar_TypeChecker_Env.env -> diff --git a/src/typechecker/FStar.TypeChecker.Env.fsti b/src/typechecker/FStar.TypeChecker.Env.fsti index 5c23de1131b..170fe2d7165 100644 --- a/src/typechecker/FStar.TypeChecker.Env.fsti +++ b/src/typechecker/FStar.TypeChecker.Env.fsti @@ -36,7 +36,7 @@ type step = | ZetaFull //fixed points, even under blocked matches | Exclude of step //the first three kinds are included by default, unless Excluded explicity | Weak //Do not descend into binders - | HNF //Only produce a head normal form + | HNF //Only produce a head normal form: Do not descend into function arguments or into binder types | Primops //reduce primitive operators like +, -, *, /, etc. | Eager_unfolding | Inlining diff --git a/src/typechecker/FStar.TypeChecker.Normalize.fst b/src/typechecker/FStar.TypeChecker.Normalize.fst index 33831383b31..2419aeb62b3 100644 --- a/src/typechecker/FStar.TypeChecker.Normalize.fst +++ b/src/typechecker/FStar.TypeChecker.Normalize.fst @@ -625,6 +625,22 @@ let filter_out_lcomp_cflags flags = let closure_as_term cfg env t = non_tail_inline_closure_env cfg env t +let binder_closure_as_term cfg env (b : binder) = + let x = { b.binder_bv with sort = closure_as_term cfg env b.binder_bv.sort } in + let imp = match b.binder_qual with + | Some (S.Meta t) -> Some (S.Meta (closure_as_term cfg env t)) + | i -> i in + let attrs = List.map (closure_as_term cfg env) b.binder_attrs in + S.mk_binder_with_attrs x imp b.binder_positivity attrs + +let binders_closure_as_term cfg env (bs : binders) = + let nbs, _ = List.fold_left (fun (nbs', env) b -> + let b = binder_closure_as_term cfg env b in + (b::nbs', dummy::env) (* crossing a binder, so shift environment *)) + ([], env) + bs in + List.rev nbs + (* A hacky knot, set by FStar.Main *) let unembed_binder_knot : ref (option (EMB.embedding binder)) = BU.mk_ref None let unembed_binder (t : term) : option S.binder = @@ -1534,7 +1550,8 @@ let rec norm : cfg -> env -> stack -> term -> term = then rebuild cfg env stack (closure_as_term cfg env t) else let bs, c = open_comp bs c in let c = norm_comp cfg (bs |> List.fold_left (fun env _ -> dummy::env) env) c in - let t = arrow (norm_binders cfg env bs) c in + let bs = if cfg.steps.hnf then binders_closure_as_term cfg env bs else norm_binders cfg env bs in + let t = arrow bs c in rebuild cfg env stack t | Tm_ascribed {tm=t1; eff_opt=l} when cfg.steps.unascribe -> diff --git a/tests/tactics/WeakVsHNF.fst b/tests/tactics/WeakVsHNF.fst index e57e3bbe91a..4e51a31e073 100644 --- a/tests/tactics/WeakVsHNF.fst +++ b/tests/tactics/WeakVsHNF.fst @@ -114,3 +114,26 @@ let _ = assert True debug ("WHNF : " ^ term_to_string t); guard (term_eq t (`(fun () -> W (1 + 1)))) ) + +let b = unit +let _ = assert True + by (let t0 = `(b -> b) in + debug ""; + debug ("Term : " ^ term_to_string t0); + + let t = norm_term [delta] t0 in + debug ("Full : " ^ term_to_string t); + guard (term_eq t (`(unit -> unit))); + + let t = norm_term [delta; weak] t0 in + debug ("Weak : " ^ term_to_string t); + guard (term_eq t (`(b -> b))); + + let t = norm_term [delta; hnf] t0 in + debug ("HNF : " ^ term_to_string t); + guard (term_eq t (`(b -> unit))); + + let t = norm_term [delta; weak; hnf] t0 in + debug ("WHNF : " ^ term_to_string t); + guard (term_eq t (`(b -> b))) + ) \ No newline at end of file diff --git a/ulib/FStar.Pervasives.fsti b/ulib/FStar.Pervasives.fsti index 87d28b63a1a..7a3a2070101 100644 --- a/ulib/FStar.Pervasives.fsti +++ b/ulib/FStar.Pervasives.fsti @@ -167,7 +167,7 @@ val simplify : norm_step (** Weak reduction: Do not reduce under binders *) val weak : norm_step -(** Head normal form *) +(** Head normal form: Do not reduce in function arguments or in binder types *) val hnf : norm_step (** Reduce primitive operators, e.g., [1 + 1 ~> 2] *) From 8da12ebd8c18d79d8ce163c7de145b3e78eb8717 Mon Sep 17 00:00:00 2001 From: Gabriel Ebner Date: Wed, 17 Apr 2024 17:24:48 -0700 Subject: [PATCH 019/239] Use close_binders function. --- .../generated/FStar_TypeChecker_Normalize.ml | 55 ++----------------- .../FStar.TypeChecker.Normalize.fst | 18 +----- 2 files changed, 6 insertions(+), 67 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml index c8a74568a02..04bc95afc05 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml @@ -1305,54 +1305,6 @@ let (closure_as_term : FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax) = fun cfg -> fun env1 -> fun t -> non_tail_inline_closure_env cfg env1 t -let (binder_closure_as_term : - FStar_TypeChecker_Cfg.cfg -> - env -> FStar_Syntax_Syntax.binder -> FStar_Syntax_Syntax.binder) - = - fun cfg -> - fun env1 -> - fun b -> - let x = - let uu___ = b.FStar_Syntax_Syntax.binder_bv in - let uu___1 = - closure_as_term cfg env1 - (b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in - { - FStar_Syntax_Syntax.ppname = (uu___.FStar_Syntax_Syntax.ppname); - FStar_Syntax_Syntax.index = (uu___.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = uu___1 - } in - let imp = - match b.FStar_Syntax_Syntax.binder_qual with - | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Meta t) -> - let uu___ = - let uu___1 = closure_as_term cfg env1 t in - FStar_Syntax_Syntax.Meta uu___1 in - FStar_Pervasives_Native.Some uu___ - | i -> i in - let attrs = - FStar_Compiler_List.map (closure_as_term cfg env1) - b.FStar_Syntax_Syntax.binder_attrs in - FStar_Syntax_Syntax.mk_binder_with_attrs x imp - b.FStar_Syntax_Syntax.binder_positivity attrs -let (binders_closure_as_term : - FStar_TypeChecker_Cfg.cfg -> - (FStar_Syntax_Syntax.binder FStar_Pervasives_Native.option * closure) - Prims.list -> - FStar_Syntax_Syntax.binders -> FStar_Syntax_Syntax.binder Prims.list) - = - fun cfg -> - fun env1 -> - fun bs -> - let uu___ = - FStar_Compiler_List.fold_left - (fun uu___1 -> - fun b -> - match uu___1 with - | (nbs', env2) -> - let b1 = binder_closure_as_term cfg env2 b in - ((b1 :: nbs'), (dummy :: env2))) ([], env1) bs in - match uu___ with | (nbs, uu___1) -> FStar_Compiler_List.rev nbs let (unembed_binder_knot : FStar_Syntax_Syntax.binder FStar_Syntax_Embeddings_Base.embedding FStar_Pervasives_Native.option FStar_Compiler_Effect.ref) @@ -3702,7 +3654,10 @@ let rec (norm : let bs2 = if (cfg.FStar_TypeChecker_Cfg.steps).FStar_TypeChecker_Cfg.hnf - then binders_closure_as_term cfg env1 bs1 + then + let uu___4 = close_binders cfg env1 bs1 in + FStar_Pervasives_Native.__proj__Mktuple2__item___1 + uu___4 else norm_binders cfg env1 bs1 in let t2 = FStar_Syntax_Util.arrow bs2 c2 in rebuild cfg env1 stack2 t2) @@ -9678,7 +9633,7 @@ let (get_n_binders : FStar_Syntax_Syntax.term -> (FStar_Syntax_Syntax.binder Prims.list * FStar_Syntax_Syntax.comp)) = fun env1 -> fun n -> fun t -> get_n_binders' env1 [] n t -let (uu___3815 : unit) = +let (uu___3792 : unit) = FStar_Compiler_Effect.op_Colon_Equals __get_n_binders get_n_binders' let (maybe_unfold_head_fv : FStar_TypeChecker_Env.env -> diff --git a/src/typechecker/FStar.TypeChecker.Normalize.fst b/src/typechecker/FStar.TypeChecker.Normalize.fst index 2419aeb62b3..9986861e353 100644 --- a/src/typechecker/FStar.TypeChecker.Normalize.fst +++ b/src/typechecker/FStar.TypeChecker.Normalize.fst @@ -625,22 +625,6 @@ let filter_out_lcomp_cflags flags = let closure_as_term cfg env t = non_tail_inline_closure_env cfg env t -let binder_closure_as_term cfg env (b : binder) = - let x = { b.binder_bv with sort = closure_as_term cfg env b.binder_bv.sort } in - let imp = match b.binder_qual with - | Some (S.Meta t) -> Some (S.Meta (closure_as_term cfg env t)) - | i -> i in - let attrs = List.map (closure_as_term cfg env) b.binder_attrs in - S.mk_binder_with_attrs x imp b.binder_positivity attrs - -let binders_closure_as_term cfg env (bs : binders) = - let nbs, _ = List.fold_left (fun (nbs', env) b -> - let b = binder_closure_as_term cfg env b in - (b::nbs', dummy::env) (* crossing a binder, so shift environment *)) - ([], env) - bs in - List.rev nbs - (* A hacky knot, set by FStar.Main *) let unembed_binder_knot : ref (option (EMB.embedding binder)) = BU.mk_ref None let unembed_binder (t : term) : option S.binder = @@ -1550,7 +1534,7 @@ let rec norm : cfg -> env -> stack -> term -> term = then rebuild cfg env stack (closure_as_term cfg env t) else let bs, c = open_comp bs c in let c = norm_comp cfg (bs |> List.fold_left (fun env _ -> dummy::env) env) c in - let bs = if cfg.steps.hnf then binders_closure_as_term cfg env bs else norm_binders cfg env bs in + let bs = if cfg.steps.hnf then (close_binders cfg env bs)._1 else norm_binders cfg env bs in let t = arrow bs c in rebuild cfg env stack t From 87e5d17aae83a992dbf739c4fcecfc771fc0e4ea Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Thu, 18 Apr 2024 11:52:50 -0700 Subject: [PATCH 020/239] trying to simplify the handling of Tm_name --- ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml | 2 -- src/smtencoding/FStar.SMTEncoding.Encode.fst | 4 ++-- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index 36f8ff0e76f..c97ddd3f23a 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -4673,8 +4673,6 @@ and (encode_sigelt' : (match uu___17 with | FStar_Syntax_Syntax.Tm_type u -> u_leq_u_k u - | FStar_Syntax_Syntax.Tm_name - uu___18 -> true | uu___18 -> false) else false)) in FStar_Compiler_List.forall2 tp_ok tps3 diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index e6c25cd519b..f5599cd589e 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -1294,8 +1294,8 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = to a universe <= the universe of the constructed type. See BugBoxInjectivity.fst *) u_leq_u_k u - | Tm_name _ -> (* this is a value of another type parameter in scope *) - true + // | Tm_name _ -> (* this is a value of another type parameter in scope *) + // true | _ -> false ) From 84d1251b7d09fcb234424e46c769fa25ea86deac Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Thu, 18 Apr 2024 13:48:31 -0700 Subject: [PATCH 021/239] simplify a counterexample; add it to the test suite --- tests/bug-reports/BugBoxInjectivity.fst | 36 +++++++++---------------- tests/bug-reports/Makefile | 3 ++- 2 files changed, 15 insertions(+), 24 deletions(-) diff --git a/tests/bug-reports/BugBoxInjectivity.fst b/tests/bug-reports/BugBoxInjectivity.fst index f46c8bd2a4e..67a21c24591 100644 --- a/tests/bug-reports/BugBoxInjectivity.fst +++ b/tests/bug-reports/BugBoxInjectivity.fst @@ -1,6 +1,6 @@ module BugBoxInjectivity -// #restart-solver -// #push-options "--log_queries --query_stats --debug BugBoxInjectivity --debug_level SMTEncoding" +#restart-solver +#push-options "--log_queries --query_stats --debug BugBoxInjectivity --debug_level SMTEncoding" module CC = FStar.Cardinality.Universes noeq type test (a:Type u#0 -> Type u#1) : Type u#1 = @@ -34,39 +34,29 @@ let itest_injective' : squash (is_inj itest) = ) [@@expect_failure [189]] //itest is not in the right universe to use this lemma let fals : squash False = - CC.no_inj_universes itest + CC.no_inj_universes_suc itest #push-options "--ext 'compat:injectivity'" noeq -type test2 (a:Type u#0 -> Type u#2) : Type u#1 = +type test2 (a:Type u#2) : Type u#1 = | Mk2 : test2 a #pop-options -let const2 (f:Type u#2) : Type u#0 -> Type u#2 = fun _ -> f -let itest2 (f:Type u#2) : Type u#1 = test2 (const2 f) -let itest2_inhabited (f:Type u#2) : itest2 f = Mk2 -let const2_inversion (f0 f1:Type u#2) -: Lemma - (requires const2 f0 == const2 f1) - (ensures f0 == f1) -= let _f0 = const2 f0 (FStar.Universe.raise_t int) in - let _f1 = const2 f1 (FStar.Universe.raise_t int) in - assert (_f0 == _f1); - () -let itest2_injective (f0 f1:Type u#2) + +let test2_inhabited (f:Type u#2) : test2 f = Mk2 +let test2_injective (f0 f1:Type u#2) : Lemma - (ensures itest2 f0 == itest2 f1 ==> const2 f0 == const2 f1) -= let x : test2 (const2 f0) = itest2_inhabited f0 in + (ensures test2 f0 == test2 f1 ==> f0 == f1) += let x : test2 f0 = test2_inhabited f0 in let Mk2 #_ = x in () open FStar.Functions -let itest2_injective' : squash (is_inj itest2) = +let itest2_injective' : squash (is_inj test2) = introduce forall f0 f1. - itest2 f0 == itest2 f1 ==> f0 == f1 + test2 f0 == test2 f1 ==> f0 == f1 with introduce _ ==> _ with _ . ( - itest2_injective f0 f1; - const2_inversion f0 f1 + test2_injective f0 f1 ) let fals () : squash False = - CC.no_inj_universes itest2 \ No newline at end of file + CC.no_inj_universes_suc test2 \ No newline at end of file diff --git a/tests/bug-reports/Makefile b/tests/bug-reports/Makefile index 02fdf17ac2f..db27584366d 100644 --- a/tests/bug-reports/Makefile +++ b/tests/bug-reports/Makefile @@ -56,7 +56,8 @@ SHOULD_VERIFY_CLOSED=Bug022.fst Bug024.fst Bug025.fst Bug026.fst Bug026b.fst Bug Bug2415.fst Bug3028.fst Bug2954.fst Bug3089.fst Bug3102.fst Bug2981.fst Bug2980.fst Bug3115.fst \ Bug2083.fst Bug2002.fst Bug1482.fst Bug1066.fst Bug3120a.fst Bug3120b.fst Bug3186.fst Bug3185.fst Bug3210.fst \ Bug3213.fst Bug3213b.fst Bug3207.fst Bug3207b.fst Bug3207c.fst Bug2155.fst Bug3224a.fst Bug3224b.fst Bug3236.fst - + BugBoxInjectivity.fst + SHOULD_VERIFY_INTERFACE_CLOSED=Bug771.fsti Bug771b.fsti SHOULD_VERIFY_AND_WARN_CLOSED=Bug016.fst From b9721d393efe9693f71cd21bb60116290c0444b9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 18 Apr 2024 16:41:01 -0700 Subject: [PATCH 022/239] Tactics: mk_tac_step5 --- ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml | 54 +++++++++---------- src/tactics/FStar.Tactics.InterpFuns.fst | 7 +++ src/tactics/FStar.Tactics.InterpFuns.fsti | 19 +++++++ .../FStar.TypeChecker.Primops.Base.fst | 33 ++++++++++++ .../FStar.TypeChecker.Primops.Base.fsti | 14 +++++ 5 files changed, 98 insertions(+), 29 deletions(-) diff --git a/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml b/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml index 37aeddfed30..c2b1eee39a8 100644 --- a/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml +++ b/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml @@ -34,35 +34,31 @@ let to_tac_1 (t: 'b -> 'a __tac): 'b -> 'a TM.tac = fun x -> (fun (ps: proofstate) -> uninterpret_tac (t x) ps) |> TM.mk_tac -let from_tac_1 s (t: 'a -> 'b TM.tac): 'a -> 'b __tac = - fun (x: 'a) -> - fun (ps: proofstate) -> - let m = t x in - interpret_tac s m ps - -let from_tac_2 s (t: 'a -> 'b -> 'c TM.tac): 'a -> 'b -> 'c __tac = - fun (x: 'a) -> - fun (y: 'b) -> - fun (ps: proofstate) -> - let m = t x y in - interpret_tac s m ps - -let from_tac_3 s (t: 'a -> 'b -> 'c -> 'd TM.tac): 'a -> 'b -> 'c -> 'd __tac = - fun (x: 'a) -> - fun (y: 'b) -> - fun (z: 'c) -> - fun (ps: proofstate) -> - let m = t x y z in - interpret_tac s m ps - -let from_tac_4 s (t: 'a -> 'b -> 'c -> 'd -> 'e TM.tac): 'a -> 'b -> 'c -> 'd -> 'e __tac = - fun (x: 'a) -> - fun (y: 'b) -> - fun (z: 'c) -> - fun (w: 'd) -> - fun (ps: proofstate) -> - let m = t x y z w in - interpret_tac s m ps +let from_tac_1 s (t: 'a -> 'r TM.tac): 'a -> 'r __tac = + fun (xa: 'a) (ps : proofstate) -> + let m = t xa in + interpret_tac s m ps + +let from_tac_2 s (t: 'a -> 'b -> 'r TM.tac): 'a -> 'b -> 'r __tac = + fun (xa: 'a) (xb: 'b) (ps : proofstate) -> + let m = t xa xb in + interpret_tac s m ps + +let from_tac_3 s (t: 'a -> 'b -> 'c -> 'r TM.tac): 'a -> 'b -> 'c -> 'r __tac = + fun (xa: 'a) (xb: 'b) (xc: 'c) (ps : proofstate) -> + let m = t xa xb xc in + interpret_tac s m ps + +let from_tac_4 s (t: 'a -> 'b -> 'c -> 'd -> 'r TM.tac): 'a -> 'b -> 'c -> 'd -> 'r __tac = + fun (xa: 'a) (xb: 'b) (xc: 'c) (xd: 'd) (ps : proofstate) -> + let m = t xa xb xc xd in + interpret_tac s m ps + +let from_tac_5 s (t: 'a -> 'b -> 'c -> 'd -> 'e -> 'r TM.tac): 'a -> 'b -> 'c -> 'd -> 'e -> 'r __tac = + fun (xa: 'a) (xb: 'b) (xc: 'c) (xd: 'd) (xe: 'e) (ps : proofstate) -> + let m = t xa xb xc xd xe in + interpret_tac s m ps + (* Pointing to the internal primitives *) let compress = from_tac_1 "B.compress" B.compress diff --git a/src/tactics/FStar.Tactics.InterpFuns.fst b/src/tactics/FStar.Tactics.InterpFuns.fst index 84a64884c12..3bedc1a9ed5 100644 --- a/src/tactics/FStar.Tactics.InterpFuns.fst +++ b/src/tactics/FStar.Tactics.InterpFuns.fst @@ -103,6 +103,13 @@ let mk_tac_step_4 univ_arity nm f nbe_f : PO.primitive_step = (fun a b c d ps -> Some (run_wrap nm (f a b c d) ps)) (fun a b c d ps -> Some (run_wrap nm (nbe_f a b c d) ps)) +let mk_tac_step_5 univ_arity nm f nbe_f : PO.primitive_step = + let lid = builtin_lid nm in + set_auto_reflect 5 <| + PO.mk6' univ_arity lid + (fun a b c d e ps -> Some (run_wrap nm (f a b c d e) ps)) + (fun a b c d e ps -> Some (run_wrap nm (nbe_f a b c d e) ps)) + let max_tac_arity = 20 (* NOTE: THE REST OF THIS MODULE IS AUTOGENERATED diff --git a/src/tactics/FStar.Tactics.InterpFuns.fsti b/src/tactics/FStar.Tactics.InterpFuns.fsti index f22c51f0203..a1d40c37d64 100644 --- a/src/tactics/FStar.Tactics.InterpFuns.fsti +++ b/src/tactics/FStar.Tactics.InterpFuns.fsti @@ -127,3 +127,22 @@ val mk_tac_step_4 : ('t1 -> 't2 -> 't3 -> 't4 -> tac 'res) -> ('nt1 -> 'nt2 -> 'nt3 -> 'nt4 -> tac 'nres) -> PO.primitive_step + +val mk_tac_step_5 : + univ_arity:int -> + string -> + {| embedding 't1 |} -> + {| embedding 't2 |} -> + {| embedding 't3 |} -> + {| embedding 't4 |} -> + {| embedding 't5 |} -> + {| embedding 'res |} -> + {| NBET.embedding 'nt1 |} -> + {| NBET.embedding 'nt2 |} -> + {| NBET.embedding 'nt3 |} -> + {| NBET.embedding 'nt4 |} -> + {| NBET.embedding 'nt5 |} -> + {| NBET.embedding 'nres |} -> + ('t1 -> 't2 -> 't3 -> 't4 -> 't5 -> tac 'res) -> + ('nt1 -> 'nt2 -> 'nt3 -> 'nt4 -> 'nt5 -> tac 'nres) -> + PO.primitive_step diff --git a/src/typechecker/FStar.TypeChecker.Primops.Base.fst b/src/typechecker/FStar.TypeChecker.Primops.Base.fst index 0ebe55d5c31..14efd9337f2 100644 --- a/src/typechecker/FStar.TypeChecker.Primops.Base.fst +++ b/src/typechecker/FStar.TypeChecker.Primops.Base.fst @@ -424,3 +424,36 @@ let mk5' #a #b #c #d #e #r #na #nb #nc #nd #ne #nr | _ -> failwith "arity" in as_primitive_step_nbecbs true (name, 5, u_arity, interp, nbe_interp) + +let mk6' #a #b #c #d #e #f #r #na #nb #nc #nd #ne #nf #nr + (u_arity : int) + (name : Ident.lid) + {| EMB.embedding a |} {| NBE.embedding na |} + {| EMB.embedding b |} {| NBE.embedding nb |} + {| EMB.embedding c |} {| NBE.embedding nc |} + {| EMB.embedding d |} {| NBE.embedding nd |} + {| EMB.embedding e |} {| NBE.embedding ne |} + {| EMB.embedding f |} {| NBE.embedding nf |} + {| EMB.embedding r |} {| NBE.embedding nr |} + (ff : a -> b -> c -> d -> e -> f -> option r) + (nbe_ff : na -> nb -> nc -> nd -> ne -> nf -> option nr) + : primitive_step = + let interp : interp_t = + fun psc cb us args -> + match args with + | [(a, _); (b, _); (c, _); (d, _); (e, _); (f, _)] -> + let! r = ff <$> try_unembed_simple a <*> try_unembed_simple b <*> try_unembed_simple c <*> try_unembed_simple d <*> try_unembed_simple e <*> try_unembed_simple f in + let! r = r in + return (embed_simple psc.psc_range r) + | _ -> failwith "arity" + in + let nbe_interp : nbe_interp_t = + fun cbs us args -> + match args with + | [(a, _); (b, _); (c, _); (d, _); (e, _); (f, _)] -> + let! r = nbe_ff <$> NBE.unembed solve cbs a <*> NBE.unembed solve cbs b <*> NBE.unembed solve cbs c <*> NBE.unembed solve cbs d <*> NBE.unembed solve cbs e <*> NBE.unembed solve cbs f in + let! r = r in + return (NBE.embed solve cbs r) + | _ -> failwith "arity" + in + as_primitive_step_nbecbs true (name, 6, u_arity, interp, nbe_interp) diff --git a/src/typechecker/FStar.TypeChecker.Primops.Base.fsti b/src/typechecker/FStar.TypeChecker.Primops.Base.fsti index 1cf83250573..f8cc19d07dc 100644 --- a/src/typechecker/FStar.TypeChecker.Primops.Base.fsti +++ b/src/typechecker/FStar.TypeChecker.Primops.Base.fsti @@ -222,3 +222,17 @@ val mk5' #a #b #c #d #e #r #na #nb #nc #nd #ne #nr (f : a -> b -> c -> d -> e -> option r) (f : na -> nb -> nc -> nd -> ne -> option nr) : primitive_step + +val mk6' #a #b #c #d #e #f #r #na #nb #nc #nd #ne #nf #nr + (u_arity : int) + (name : Ident.lid) + {| EMB.embedding a |} {| NBE.embedding na |} + {| EMB.embedding b |} {| NBE.embedding nb |} + {| EMB.embedding c |} {| NBE.embedding nc |} + {| EMB.embedding d |} {| NBE.embedding nd |} + {| EMB.embedding e |} {| NBE.embedding ne |} + {| EMB.embedding f |} {| NBE.embedding nf |} + {| EMB.embedding r |} {| NBE.embedding nr |} + (f : a -> b -> c -> d -> e -> f -> option r) + (f : na -> nb -> nc -> nd -> ne -> nf -> option nr) + : primitive_step From 207056c6f34b064a23a92c1bc5551a74f6f7a543 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 15 Apr 2024 15:40:38 -0700 Subject: [PATCH 023/239] Core/Tactics: controlling SMT guards and unfolding for check_equiv --- src/tactics/FStar.Tactics.V1.Basic.fst | 2 +- src/tactics/FStar.Tactics.V2.Basic.fst | 10 ++--- src/tests/FStar.Tests.Unif.fst | 4 +- src/typechecker/FStar.TypeChecker.Core.fst | 42 +++++++++++++-------- src/typechecker/FStar.TypeChecker.Core.fsti | 6 +-- ulib/FStar.Stubs.Tactics.V2.Builtins.fsti | 3 ++ 6 files changed, 41 insertions(+), 26 deletions(-) diff --git a/src/tactics/FStar.Tactics.V1.Basic.fst b/src/tactics/FStar.Tactics.V1.Basic.fst index fd20fc9a57d..bfdff0c017c 100644 --- a/src/tactics/FStar.Tactics.V1.Basic.fst +++ b/src/tactics/FStar.Tactics.V1.Basic.fst @@ -1423,7 +1423,7 @@ let _t_trefl (allow_guards:bool) (l : term) (r : term) : tac unit = with | Inr _ -> false | Inl (_, t_ty) -> ( // ignoring the effect, ghost is ok - match Core.check_term_subtyping env ty t_ty with + match Core.check_term_subtyping true true env ty t_ty with | Inl None -> //unconditional subtype mark_uvar_as_already_checked u; true diff --git a/src/tactics/FStar.Tactics.V2.Basic.fst b/src/tactics/FStar.Tactics.V2.Basic.fst index 054f886ecbd..84f13f7fd5a 100644 --- a/src/tactics/FStar.Tactics.V2.Basic.fst +++ b/src/tactics/FStar.Tactics.V2.Basic.fst @@ -1426,7 +1426,7 @@ let _t_trefl (allow_guards:bool) (l : term) (r : term) : tac unit = with | Inr _ -> false | Inl (_, t_ty) -> ( // ignoring effect, ghost is ok - match Core.check_term_subtyping env ty t_ty with + match Core.check_term_subtyping true true env ty t_ty with | Inl None -> //unconditional subtype mark_uvar_as_already_checked u; true @@ -2268,7 +2268,7 @@ let refl_is_non_informative (g:env) (t:typ) : tac (option unit & issues) = return (None, [unexpected_uvars_issue (Env.get_range g)]) ) -let refl_check_relation (g:env) (t0 t1:typ) (rel:relation) +let refl_check_relation (smt_ok:bool) (unfolding_ok:bool) (g:env) (t0 t1:typ) (rel:relation) : tac (option unit * issues) = if no_uvars_in_g g && @@ -2285,7 +2285,7 @@ let refl_check_relation (g:env) (t0 t1:typ) (rel:relation) if rel = Subtyping then Core.check_term_subtyping else Core.check_term_equality in - match f g t0 t1 with + match f smt_ok unfolding_ok g t0 t1 with | Inl None -> dbg_refl g (fun _ -> "refl_check_relation: succeeded (no guard)"); ((), []) @@ -2301,10 +2301,10 @@ let refl_check_relation (g:env) (t0 t1:typ) (rel:relation) ) let refl_check_subtyping (g:env) (t0 t1:typ) : tac (option unit & issues) = - refl_check_relation g t0 t1 Subtyping + refl_check_relation true true g t0 t1 Subtyping let refl_check_equiv (g:env) (t0 t1:typ) : tac (option unit & issues) = - refl_check_relation g t0 t1 Equality + refl_check_relation true true g t0 t1 Equality let to_must_tot (eff:Core.tot_or_ghost) : bool = match eff with diff --git a/src/tests/FStar.Tests.Unif.fst b/src/tests/FStar.Tests.Unif.fst index 570d2344380..a6fe86d36c6 100644 --- a/src/tests/FStar.Tests.Unif.fst +++ b/src/tests/FStar.Tests.Unif.fst @@ -96,8 +96,8 @@ let check_core i subtyping guard_ok x y = let env = tcenv () in let res = if subtyping - then FStar.TypeChecker.Core.check_term_subtyping env x y - else FStar.TypeChecker.Core.check_term_equality env x y + then FStar.TypeChecker.Core.check_term_subtyping true true env x y + else FStar.TypeChecker.Core.check_term_equality true true env x y in let _ = match res with diff --git a/src/typechecker/FStar.TypeChecker.Core.fst b/src/typechecker/FStar.TypeChecker.Core.fst index ee59a716f2b..5cc4a4b1675 100644 --- a/src/typechecker/FStar.TypeChecker.Core.fst +++ b/src/typechecker/FStar.TypeChecker.Core.fst @@ -163,14 +163,16 @@ let context_term_to_string (c:context_term) = type context = { no_guard : bool; + unfolding_ok : bool; error_context: list (string & option context_term) } (* The instance prints some brief info on the error_context. `print_context` below is a full printer. *) instance showable_context : showable context = { - show = (fun context -> BU.format2 "{no_guard=%s, error_context=%s}" + show = (fun context -> BU.format3 "{no_guard=%s; unfolding_ok=%s; error_context=%s}" (show context.no_guard) + (show context.unfolding_ok) (show (List.map fst context.error_context))); } @@ -691,6 +693,10 @@ let guard_not_allowed : result bool = fun ctx -> Success (ctx.no_guard, None) +let unfolding_ok + : result bool + = fun ctx -> Success (ctx.unfolding_ok, None) + let debug g f = if Env.debug g.tcenv (Options.Other "Core") then f () @@ -830,8 +836,10 @@ let rec check_relation (g:env) (rel:relation) (t0 t1:typ) "FStar.TypeChecker.Core.maybe_unfold_side" in let maybe_unfold t0 t1 - : option (term & term) - = maybe_unfold_side (which_side_to_unfold t0 t1) t0 t1 + : result (option (term & term)) + = if! unfolding_ok + then return (maybe_unfold_side (which_side_to_unfold t0 t1) t0 t1) + else return None in let emit_guard t0 t1 = let! _, t_typ = do_check g t0 in @@ -847,9 +855,12 @@ let rec check_relation (g:env) (rel:relation) (t0 t1:typ) else err () in let maybe_unfold_side_and_retry side t0 t1 = - match maybe_unfold_side side t0 t1 with - | None -> fallback t0 t1 - | Some (t0, t1) -> check_relation g rel t0 t1 + if! unfolding_ok then + match maybe_unfold_side side t0 t1 with + | None -> fallback t0 t1 + | Some (t0, t1) -> check_relation g rel t0 t1 + else + fallback t0 t1 in let maybe_unfold_and_retry t0 t1 = maybe_unfold_side_and_retry (which_side_to_unfold t0 t1) t0 t1 @@ -948,7 +959,7 @@ let rec check_relation (g:env) (rel:relation) (t0 t1:typ) guard (U.mk_forall u b.binder_bv (U.mk_imp f0 f1))) ) else ( - match maybe_unfold x0.sort x1.sort with + match! maybe_unfold x0.sort x1.sort with | None -> fallback t0 t1 | Some (t0, t1) -> let lhs = S.mk (Tm_refine {b={x0 with sort = t0}; phi=f0}) t0.pos in @@ -960,7 +971,7 @@ let rec check_relation (g:env) (rel:relation) (t0 t1:typ) if head_matches x0.sort t1 then check_relation g rel x0.sort t1 else ( - match maybe_unfold x0.sort t1 with + match! maybe_unfold x0.sort t1 with | None -> fallback t0 t1 | Some (t0, t1) -> let lhs = S.mk (Tm_refine {b={x0 with sort = t0}; phi=f0}) t0.pos in @@ -994,7 +1005,7 @@ let rec check_relation (g:env) (rel:relation) (t0 t1:typ) guard (U.mk_forall u1 b1.binder_bv f1) ) else ( - match maybe_unfold t0 x1.sort with + match! maybe_unfold t0 x1.sort with | None -> fallback t0 t1 | Some (t0, t1) -> let rhs = S.mk (Tm_refine {b={x1 with sort = t1}; phi=f1}) t1.pos in @@ -1855,7 +1866,7 @@ let check_term_top_gh g e topt (must_tot:bool) (gh:option guard_handler_t) (match topt with None -> "" | Some t -> P.term_to_string t); THT.reset_counters table; reset_cache_stats(); - let ctx = { no_guard = false; error_context = [("Top", None)] } in + let ctx = { unfolding_ok = true; no_guard = false; error_context = [("Top", None)] } in let res = Profiling.profile (fun () -> @@ -1946,11 +1957,12 @@ let open_binders_in_comp (env:Env.env) (bs:binders) (c:comp) = let g', bs, c = open_comp_binders g bs c in g'.tcenv, bs, c -let check_term_equality g t0 t1 +let check_term_equality guard_ok unfolding_ok g t0 t1 = let g = initial_env g None in if Env.debug g.tcenv (Options.Other "CoreTop") then - BU.print2 "Entering check_term_equality with %s and %s {\n" (show t0) (show t1); - let ctx = { no_guard = false ; error_context = [("Eq", None)] } in + BU.print4 "Entering check_term_equality with %s and %s (guard_ok=%s; unfolding_ok=%s) {\n" + (show t0) (show t1) (show guard_ok) (show unfolding_ok); + let ctx = { unfolding_ok = unfolding_ok; no_guard = not guard_ok; error_context = [("Eq", None)] } in let r = check_relation g EQUALITY t0 t1 ctx in if Env.debug g.tcenv (Options.Other "CoreTop") then BU.print3 "} Exiting check_term_equality (%s, %s). Result = %s.\n" (show t0) (show t1) (show r); @@ -1961,9 +1973,9 @@ let check_term_equality g t0 t1 in r -let check_term_subtyping g t0 t1 +let check_term_subtyping guard_ok unfolding_ok g t0 t1 = let g = initial_env g None in - let ctx = { no_guard = false; error_context = [("Subtyping", None)] } in + let ctx = { unfolding_ok = unfolding_ok; no_guard = not guard_ok; error_context = [("Subtyping", None)] } in match check_relation g (SUBTYPING None) t0 t1 ctx with | Success (_, g) -> Inl g | Error err -> Inr err diff --git a/src/typechecker/FStar.TypeChecker.Core.fsti b/src/typechecker/FStar.TypeChecker.Core.fsti index 9d2e3432609..6f05e4fa321 100644 --- a/src/typechecker/FStar.TypeChecker.Core.fsti +++ b/src/typechecker/FStar.TypeChecker.Core.fsti @@ -43,11 +43,11 @@ val open_binders_in_term (g:Env.env) (bs:binders) (t:term) val open_binders_in_comp (g:Env.env) (bs:binders) (c:comp) : Env.env & binders & comp -(* for unit testing *) -val check_term_equality (g:Env.env) (t0 t1:typ) +(* For unit testing, and exposed to tactics *) +val check_term_equality (guard_ok:bool) (unfolding_ok:bool) (g:Env.env) (t0 t1:typ) : either (option typ) error -val check_term_subtyping (g:Env.env) (t0 t1:typ) +val check_term_subtyping (guard_ok:bool) (unfolding_ok:bool) (g:Env.env) (t0 t1:typ) : either (option typ) error val print_error (err:error) diff --git a/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti b/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti index 2c84152aaec..351cf79275d 100644 --- a/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti +++ b/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti @@ -487,6 +487,9 @@ val check_subtyping (g:env) (t0 t1:typ) val check_equiv (g:env) (t0 t1:typ) : Tac (ret_t (equiv_token g t0 t1)) +val check_equiv_nosmt (g:env) (t0 t1:typ) + : Tac (ret_t (equiv_token g t0 t1)) + // // Compute the type of e using the core typechecker // From 8370a6e3a32e4a1bf1780f17e726038e05b5c9f7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 15 Apr 2024 22:11:04 -0700 Subject: [PATCH 024/239] Core.check_equiv: always WHNF --- src/typechecker/FStar.TypeChecker.Core.fst | 12 +----------- 1 file changed, 1 insertion(+), 11 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.Core.fst b/src/typechecker/FStar.TypeChecker.Core.fst index 5cc4a4b1675..994d9272994 100644 --- a/src/typechecker/FStar.TypeChecker.Core.fst +++ b/src/typechecker/FStar.TypeChecker.Core.fst @@ -867,20 +867,10 @@ let rec check_relation (g:env) (rel:relation) (t0 t1:typ) in let beta_iota_reduce t = let t = Subst.compress t in + let t = N.normalize [Env.HNF; Env.Weak; Env.Beta; Env.Iota; Env.Primops] g.tcenv t in match t.n with - | Tm_app _ -> - let head = U.leftmost_head t in - (match (Subst.compress head).n with - | Tm_abs _ -> N.normalize [Env.Beta; Env.Iota; Env.Primops] g.tcenv t - | _ -> t) - - | Tm_let _ - | Tm_match _ -> - N.normalize [Env.Beta;Env.Iota;Env.Primops] g.tcenv t - | Tm_refine _ -> U.flatten_refinement t - | _ -> t in let beta_iota_reduce t = From a8d5b00cca6f740c00a37bf6235b6261210270b4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 18 Apr 2024 15:18:19 -0700 Subject: [PATCH 025/239] Core: more error contexts --- src/typechecker/FStar.TypeChecker.Core.fst | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.Core.fst b/src/typechecker/FStar.TypeChecker.Core.fst index 994d9272994..208b9e48e12 100644 --- a/src/typechecker/FStar.TypeChecker.Core.fst +++ b/src/typechecker/FStar.TypeChecker.Core.fst @@ -842,7 +842,7 @@ let rec check_relation (g:env) (rel:relation) (t0 t1:typ) else return None in let emit_guard t0 t1 = - let! _, t_typ = do_check g t0 in + let! _, t_typ = with_context "checking lhs while emitting guard" None (fun _ -> do_check g t0) in let! u = universe_of g t_typ in guard (U.mk_eq2 u t_typ t0 t1) in @@ -950,7 +950,10 @@ let rec check_relation (g:env) (rel:relation) (t0 t1:typ) ) else ( match! maybe_unfold x0.sort x1.sort with - | None -> fallback t0 t1 + | None -> + if Env.debug g.tcenv (Options.Other "Core") then + BU.print2 "Cannot match ref heads %s and %s\n" (show x0.sort) (show x1.sort); + fallback t0 t1 | Some (t0, t1) -> let lhs = S.mk (Tm_refine {b={x0 with sort = t0}; phi=f0}) t0.pos in let rhs = S.mk (Tm_refine {b={x1 with sort = t1}; phi=f1}) t1.pos in @@ -1105,7 +1108,7 @@ let rec check_relation (g:env) (rel:relation) (t0 t1:typ) let bs0 = List.map S.mk_binder bvs0 in // We need universes for the binders let! us = check_binders g bs0 in - with_binders bs0 us (check_relation g' rel body0 body1) + with_context "relate_branch" None (fun _ -> with_binders bs0 us (check_relation g' rel body0 body1)) | _ -> fail "raw_pat_as_exp failed in check_equality match rule" end | _ -> fail "Core does not support branches with when" @@ -1375,7 +1378,7 @@ and do_check (g:env) (e:term) let! eff, te = check "ascription head" g e in let! _ = with_context "ascription comp" None (fun _ -> check_comp g c) in let c_e = as_comp g (eff, te) in - check_relation_comp g (SUBTYPING (Some e)) c_e c;! + with_context "ascription subtyping (comp)" None (fun _ -> check_relation_comp g (SUBTYPING (Some e)) c_e c);! let Some (eff, t) = comp_as_tot_or_ghost_and_type c in return (eff, t) ) @@ -1524,7 +1527,7 @@ and do_check (g:env) (e:term) then EQUALITY else SUBTYPING (Some b) in - check_relation g' rel tbr expect_tbr;! + with_context "branch check relation" None (fun _ -> check_relation g' rel tbr expect_tbr);! return (join_eff eff_br acc_eff, expect_tbr))) in match p.v with | Pat_var _ -> @@ -1616,7 +1619,7 @@ and check_pat (g:env) (p:pat) (t_sc:typ) : result (binders & universes) = | _ -> mk (Tm_constant c) p.p in let! _, t_const = check "pat_const" g e in - let! _ = check_subtype g (Some e) t_const (unrefine_tsc t_sc) in + let! _ = with_context "check_pat constant" None (fun () -> check_subtype g (Some e) t_const (unrefine_tsc t_sc)) in return ([], []) | Pat_var bv -> @@ -1650,7 +1653,7 @@ and check_pat (g:env) (p:pat) (t_sc:typ) : result (binders & universes) = | _ -> fail "check_pat in core has unset dot pattern" in let! _, p_t = check "pat dot term" g pat_dot_t in - let!_ = check_subtype g (Some pat_dot_t) p_t expected_t in + let!_ = with_context "check_pat cons" None (fun _ -> check_subtype g (Some pat_dot_t) p_t expected_t) in return (ss@[NT (f, pat_dot_t)])) [] dot_formals dot_pats in From 1afea7e0c2db084762b1f249e03c6517cea3341d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 18 Apr 2024 15:18:45 -0700 Subject: [PATCH 026/239] Core: allow checking pure/ghost (non-Tot) lets --- src/typechecker/FStar.TypeChecker.Core.fst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/typechecker/FStar.TypeChecker.Core.fst b/src/typechecker/FStar.TypeChecker.Core.fst index 208b9e48e12..f241a8edea6 100644 --- a/src/typechecker/FStar.TypeChecker.Core.fst +++ b/src/typechecker/FStar.TypeChecker.Core.fst @@ -1387,7 +1387,7 @@ and do_check (g:env) (e:term) | Tm_let {lbs=(false, [lb]); body} -> let Inl x = lb.lbname in let g', x, body = open_term g (S.mk_binder x) body in - if I.lid_equals lb.lbeff PC.effect_Tot_lid + if U.is_pure_or_ghost_effect lb.lbeff then ( let! eff_def, tdef = check "let definition" g lb.lbdef in let! _, ttyp = check "let type" g lb.lbtyp in From ec8e3586e88a91cc5581ae42581af5d347ee0707 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 18 Apr 2024 15:19:01 -0700 Subject: [PATCH 027/239] Core: fix checking of letbinding ttyp is the type of the *annotation* of the letbinding, not the annotation itself. Fix it. --- src/typechecker/FStar.TypeChecker.Core.fst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/typechecker/FStar.TypeChecker.Core.fst b/src/typechecker/FStar.TypeChecker.Core.fst index f241a8edea6..237e0494493 100644 --- a/src/typechecker/FStar.TypeChecker.Core.fst +++ b/src/typechecker/FStar.TypeChecker.Core.fst @@ -1392,7 +1392,7 @@ and do_check (g:env) (e:term) let! eff_def, tdef = check "let definition" g lb.lbdef in let! _, ttyp = check "let type" g lb.lbtyp in let! u = is_type g ttyp in - with_context "let subtyping" None (fun _ -> check_subtype g (Some lb.lbdef) tdef ttyp) ;! + with_context "let subtyping" None (fun _ -> check_subtype g (Some lb.lbdef) tdef lb.lbtyp) ;! with_definition x u lb.lbdef ( let! eff_body, t = check "let body" g' body in check_no_escape [x] t;! From c46481f4ca757b31e4c84e2aaf88a680af3e9f19 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 15 Apr 2024 20:11:48 -0700 Subject: [PATCH 028/239] More tests for check_equiv --- tests/tactics/CheckEquiv.fst | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/tests/tactics/CheckEquiv.fst b/tests/tactics/CheckEquiv.fst index 38a378bf72e..59c727778ca 100644 --- a/tests/tactics/CheckEquiv.fst +++ b/tests/tactics/CheckEquiv.fst @@ -36,3 +36,30 @@ let _ = assert True by begin let _ = must <| check_equiv env (`1) (`(reveal u#0 #int (hide u#0 #int 1))) in () end + +[@@expect_failure] // this is fine, as nosmt implies nodelta +let _ = assert True by begin + let env = cur_env () in + let _ = must <| check_equiv_nosmt env (`1) (`(g 1)) in + () +end + +let _ = assert True by begin + let env = cur_env () in + let _ = must <| check_equiv_nosmt env (`1) (`1) in + () +end + +let _ = assert True by begin + let env = cur_env () in + let _ = must <| check_equiv_nosmt env (`(1+1)) (`(3-1)) in + () +end + +let _ = assert True by begin + let env = cur_env () in + let _ = must <| check_equiv_nosmt env (`1) (`(reveal #int (hide #int 1))) in + () +end + +#pop-options From 2c2e29b412e58522ae19ff92ceb955fb171e46df Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 18 Apr 2024 16:50:14 -0700 Subject: [PATCH 029/239] Tactics: exposing full check_equiv with both flags --- ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml | 2 +- src/tactics/FStar.Tactics.V2.Basic.fst | 7 +++---- src/tactics/FStar.Tactics.V2.Basic.fsti | 2 +- src/tactics/FStar.Tactics.V2.Primops.fst | 2 +- ulib/FStar.Stubs.Tactics.V2.Builtins.fsti | 5 +---- ulib/FStar.Tactics.V2.Derived.fst | 4 ++++ 6 files changed, 11 insertions(+), 11 deletions(-) diff --git a/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml b/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml index c2b1eee39a8..e9e1ea19382 100644 --- a/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml +++ b/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml @@ -142,7 +142,7 @@ type ('env, 'sc, 't, 'pats, 'bnds) match_complete_token = unit let is_non_informative = from_tac_2 "B.refl_is_non_informative" B.refl_is_non_informative let check_subtyping = from_tac_3 "B.refl_check_subtyping" B.refl_check_subtyping -let check_equiv = from_tac_3 "B.refl_check_equiv" B.refl_check_equiv +let t_check_equiv = from_tac_5 "B.t_refl_check_equiv" B.t_refl_check_equiv let core_compute_term_type = from_tac_2 "B.refl_core_compute_term_type" B.refl_core_compute_term_type let core_check_term = from_tac_4 "B.refl_core_check_term" B.refl_core_check_term let core_check_term_at_type = from_tac_3 "B.refl_core_check_term_at_type" B.refl_core_check_term_at_type diff --git a/src/tactics/FStar.Tactics.V2.Basic.fst b/src/tactics/FStar.Tactics.V2.Basic.fst index 84f13f7fd5a..9b885c41bc5 100644 --- a/src/tactics/FStar.Tactics.V2.Basic.fst +++ b/src/tactics/FStar.Tactics.V2.Basic.fst @@ -2268,7 +2268,7 @@ let refl_is_non_informative (g:env) (t:typ) : tac (option unit & issues) = return (None, [unexpected_uvars_issue (Env.get_range g)]) ) -let refl_check_relation (smt_ok:bool) (unfolding_ok:bool) (g:env) (t0 t1:typ) (rel:relation) +let refl_check_relation (rel:relation) (smt_ok:bool) (unfolding_ok:bool) (g:env) (t0 t1:typ) : tac (option unit * issues) = if no_uvars_in_g g && @@ -2301,10 +2301,9 @@ let refl_check_relation (smt_ok:bool) (unfolding_ok:bool) (g:env) (t0 t1:typ) (r ) let refl_check_subtyping (g:env) (t0 t1:typ) : tac (option unit & issues) = - refl_check_relation true true g t0 t1 Subtyping + refl_check_relation Subtyping true true g t0 t1 -let refl_check_equiv (g:env) (t0 t1:typ) : tac (option unit & issues) = - refl_check_relation true true g t0 t1 Equality +let t_refl_check_equiv = refl_check_relation Equality let to_must_tot (eff:Core.tot_or_ghost) : bool = match eff with diff --git a/src/tactics/FStar.Tactics.V2.Basic.fsti b/src/tactics/FStar.Tactics.V2.Basic.fsti index e0a2308c80d..ae3379cc5ce 100644 --- a/src/tactics/FStar.Tactics.V2.Basic.fsti +++ b/src/tactics/FStar.Tactics.V2.Basic.fsti @@ -127,7 +127,7 @@ val write : tref 'a -> 'a -> tac unit let issues = list FStar.Errors.issue val refl_is_non_informative : env -> typ -> tac (option unit & issues) val refl_check_subtyping : env -> typ -> typ -> tac (option unit & issues) -val refl_check_equiv : env -> typ -> typ -> tac (option unit & issues) +val t_refl_check_equiv : smt_ok:bool -> unfolding_ok:bool -> env -> typ -> typ -> tac (option unit & issues) val refl_core_compute_term_type : env -> term -> tac (option (Core.tot_or_ghost & typ) & issues) val refl_core_check_term : env -> term -> typ -> Core.tot_or_ghost -> tac (option unit & issues) val refl_core_check_term_at_type : env -> term -> typ -> tac (option Core.tot_or_ghost & issues) diff --git a/src/tactics/FStar.Tactics.V2.Primops.fst b/src/tactics/FStar.Tactics.V2.Primops.fst index bfc652203ac..0c0d00f3f8b 100644 --- a/src/tactics/FStar.Tactics.V2.Primops.fst +++ b/src/tactics/FStar.Tactics.V2.Primops.fst @@ -242,7 +242,7 @@ let ops = [ mk_tac_step_2 0 "is_non_informative" #_ #RE.e_term refl_is_non_informative refl_is_non_informative; mk_tac_step_3 0 "check_subtyping" #_ #RE.e_term #RE.e_term refl_check_subtyping refl_check_subtyping; - mk_tac_step_3 0 "check_equiv" #_ #RE.e_term #RE.e_term refl_check_equiv refl_check_equiv; + mk_tac_step_5 0 "t_check_equiv" #_ #_ #_ #RE.e_term #RE.e_term t_refl_check_equiv t_refl_check_equiv; mk_tac_step_2 0 "core_compute_term_type" #_ #RE.e_term #(e_ret_t (e_tuple2 solve RE.e_term)) refl_core_compute_term_type refl_core_compute_term_type; mk_tac_step_4 0 "core_check_term" #_ #RE.e_term #RE.e_term refl_core_check_term refl_core_check_term; mk_tac_step_3 0 "core_check_term_at_type" #_ #RE.e_term #RE.e_term refl_core_check_term_at_type refl_core_check_term_at_type; diff --git a/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti b/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti index 351cf79275d..71a985a900d 100644 --- a/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti +++ b/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti @@ -484,10 +484,7 @@ val is_non_informative (g:env) (t:typ) val check_subtyping (g:env) (t0 t1:typ) : Tac (ret_t (subtyping_token g t0 t1)) -val check_equiv (g:env) (t0 t1:typ) - : Tac (ret_t (equiv_token g t0 t1)) - -val check_equiv_nosmt (g:env) (t0 t1:typ) +val t_check_equiv (smt_ok:bool) (unfolding_ok:bool) (g:env) (t0 t1:typ) : Tac (ret_t (equiv_token g t0 t1)) // diff --git a/ulib/FStar.Tactics.V2.Derived.fst b/ulib/FStar.Tactics.V2.Derived.fst index ba3f32a7bbe..0b791d5cb6a 100644 --- a/ulib/FStar.Tactics.V2.Derived.fst +++ b/ulib/FStar.Tactics.V2.Derived.fst @@ -942,3 +942,7 @@ let smt_sync' (fuel ifuel : nat) : Tac unit = ; initial_ifuel = ifuel; max_ifuel = ifuel } in t_smt_sync vcfg' + +(* t_check_equiv wrappers. *) +let check_equiv g t0 t1 = t_check_equiv true true g t0 t1 +let check_equiv_nosmt g t0 t1 = t_check_equiv false false g t0 t1 From de492542d1432f48329604185047348deac44ace Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 18 Apr 2024 16:59:17 -0700 Subject: [PATCH 030/239] Tactics: remove some boilerplate --- src/tactics/FStar.Tactics.V2.Primops.fst | 72 ++++++++++++------------ 1 file changed, 36 insertions(+), 36 deletions(-) diff --git a/src/tactics/FStar.Tactics.V2.Primops.fst b/src/tactics/FStar.Tactics.V2.Primops.fst index 0c0d00f3f8b..cff3bb45cc6 100644 --- a/src/tactics/FStar.Tactics.V2.Primops.fst +++ b/src/tactics/FStar.Tactics.V2.Primops.fst @@ -90,8 +90,8 @@ let ops = [ mk_tot_step_1 0 "goals_of" goals_of goals_of; mk_tot_step_1 0 "smt_goals_of" smt_goals_of smt_goals_of; mk_tot_step_1 0 "goal_env" goal_env goal_env; - mk_tot_step_1 0 "goal_type" #_ #RE.e_term goal_type goal_type; - mk_tot_step_1 0 "goal_witness" #_ #RE.e_term goal_witness goal_witness; + mk_tot_step_1 0 "goal_type" goal_type goal_type; + mk_tot_step_1 0 "goal_witness" goal_witness goal_witness; mk_tot_step_1 0 "is_guard" is_guard is_guard; mk_tot_step_1 0 "get_label" get_label get_label; mk_tot_step_2 0 "set_label" set_label set_label; @@ -100,7 +100,7 @@ let ops = [ unseal_step; - mk_tac_step_1 0 "compress" #RE.e_term #RE.e_term compress compress; + mk_tac_step_1 0 "compress" compress compress; mk_tac_step_1 0 "set_goals" set_goals set_goals; mk_tac_step_1 0 "set_smt_goals" set_smt_goals set_smt_goals; @@ -119,7 +119,7 @@ let ops = [ mk_tac_step_1 0 "intro" intro intro; mk_tac_step_1 0 "intro_rec" intro_rec intro_rec; mk_tac_step_1 0 "norm" norm norm; - mk_tac_step_3 0 "norm_term_env" #_ #_ #RE.e_term #RE.e_term norm_term_env norm_term_env; + mk_tac_step_3 0 "norm_term_env" norm_term_env norm_term_env; mk_tac_step_2 0 "norm_binding_type" norm_binding_type norm_binding_type; mk_tac_step_2 0 "rename_to" rename_to rename_to; mk_tac_step_1 0 "var_retype" var_retype var_retype; @@ -128,13 +128,13 @@ let ops = [ mk_tac_step_1 0 "clear" clear clear; mk_tac_step_1 0 "rewrite" rewrite rewrite; mk_tac_step_1 0 "refine_intro" refine_intro refine_intro; - mk_tac_step_3 0 "t_exact" #_ #_ #RE.e_term t_exact t_exact; - mk_tac_step_4 0 "t_apply" #_ #_ #_ #RE.e_term t_apply t_apply; - mk_tac_step_3 0 "t_apply_lemma" #_ #_ #RE.e_term t_apply_lemma t_apply_lemma; + mk_tac_step_3 0 "t_exact" t_exact t_exact; + mk_tac_step_4 0 "t_apply" t_apply t_apply; + mk_tac_step_3 0 "t_apply_lemma" t_apply_lemma t_apply_lemma; mk_tac_step_1 0 "set_options" set_options set_options; - mk_tac_step_2 0 "tcc" #_ #RE.e_term tcc tcc; - mk_tac_step_2 0 "tc" #_ #RE.e_term #RE.e_term tc tc; - mk_tac_step_1 0 "unshelve" #RE.e_term unshelve unshelve; + mk_tac_step_2 0 "tcc" tcc tcc; + mk_tac_step_2 0 "tc" tc tc; + mk_tac_step_1 0 "unshelve" unshelve unshelve; mk_tac_step_2 1 "unquote" #e_any #RE.e_term #e_any @@ -162,20 +162,20 @@ let ops = [ mk_tac_step_1 0 "t_trefl" t_trefl t_trefl; mk_tac_step_1 0 "dup" dup dup; - mk_tac_step_1 0 "tadmit_t" #RE.e_term tadmit_t tadmit_t; + mk_tac_step_1 0 "tadmit_t" tadmit_t tadmit_t; mk_tac_step_1 0 "join" join join; - mk_tac_step_1 0 "t_destruct" #RE.e_term t_destruct t_destruct; + mk_tac_step_1 0 "t_destruct" t_destruct t_destruct; mk_tac_step_1 0 "top_env" top_env top_env; mk_tac_step_1 0 "fresh" fresh fresh; mk_tac_step_1 0 "curms" curms curms; - mk_tac_step_2 0 "uvar_env" #_ #(e_option RE.e_term) #RE.e_term uvar_env uvar_env; - mk_tac_step_2 0 "ghost_uvar_env" #_ #RE.e_term #RE.e_term ghost_uvar_env ghost_uvar_env; - mk_tac_step_1 0 "fresh_universe_uvar" #_ #RE.e_term fresh_universe_uvar fresh_universe_uvar; - mk_tac_step_3 0 "unify_env" #_ #RE.e_term #RE.e_term unify_env unify_env; - mk_tac_step_3 0 "unify_guard_env" #_ #RE.e_term #RE.e_term unify_guard_env unify_guard_env; - mk_tac_step_3 0 "match_env" #_ #RE.e_term #RE.e_term match_env match_env; + mk_tac_step_2 0 "uvar_env" uvar_env uvar_env; + mk_tac_step_2 0 "ghost_uvar_env" ghost_uvar_env ghost_uvar_env; + mk_tac_step_1 0 "fresh_universe_uvar" fresh_universe_uvar fresh_universe_uvar; + mk_tac_step_3 0 "unify_env" unify_env unify_env; + mk_tac_step_3 0 "unify_guard_env" unify_guard_env unify_guard_env; + mk_tac_step_3 0 "match_env" match_env match_env; mk_tac_step_3 0 "launch_process" launch_process launch_process; - mk_tac_step_1 0 "change" #RE.e_term change change; + mk_tac_step_1 0 "change" change change; mk_tac_step_1 0 "get_guard_policy" get_guard_policy get_guard_policy; mk_tac_step_1 0 "set_guard_policy" set_guard_policy set_guard_policy; mk_tac_step_1 0 "lax_on" lax_on lax_on; @@ -197,14 +197,14 @@ let ops = [ mk_tac_step_1 0 "gather_or_solve_explicit_guards_for_resolved_goals" gather_explicit_guards_for_resolved_goals gather_explicit_guards_for_resolved_goals; - mk_tac_step_2 0 "string_to_term" #_ #_ #RE.e_term string_to_term string_to_term; + mk_tac_step_2 0 "string_to_term" string_to_term string_to_term; mk_tac_step_2 0 "push_bv_dsenv" push_bv_dsenv push_bv_dsenv; - mk_tac_step_1 0 "term_to_string" #RE.e_term term_to_string term_to_string; + mk_tac_step_1 0 "term_to_string" term_to_string term_to_string; mk_tac_step_1 0 "comp_to_string" comp_to_string comp_to_string; - mk_tac_step_1 0 "term_to_doc" #RE.e_term term_to_doc term_to_doc; + mk_tac_step_1 0 "term_to_doc" term_to_doc term_to_doc; mk_tac_step_1 0 "comp_to_doc" comp_to_doc comp_to_doc; mk_tac_step_1 0 "range_to_string" range_to_string range_to_string; - mk_tac_step_2 0 "term_eq_old" #RE.e_term #RE.e_term term_eq_old term_eq_old; + mk_tac_step_2 0 "term_eq_old" term_eq_old term_eq_old; mk_tac_step_3 1 "with_compat_pre_core" #e_any #e_int #(TI.e_tactic_thunk e_any) #e_any @@ -215,7 +215,7 @@ let ops = [ mk_tac_step_1 0 "get_vconfig" get_vconfig get_vconfig; mk_tac_step_1 0 "set_vconfig" set_vconfig set_vconfig; mk_tac_step_1 0 "t_smt_sync" t_smt_sync t_smt_sync; - mk_tac_step_1 0 "free_uvars" #RE.e_term free_uvars free_uvars; + mk_tac_step_1 0 "free_uvars" free_uvars free_uvars; mk_tac_step_1 0 "all_ext_options" all_ext_options all_ext_options; mk_tac_step_1 0 "ext_getv" ext_getv ext_getv; mk_tac_step_1 0 "ext_getns" ext_getns ext_getns; @@ -240,23 +240,23 @@ let ops = [ // reflection typechecker callbacks (part of the DSL framework) - mk_tac_step_2 0 "is_non_informative" #_ #RE.e_term refl_is_non_informative refl_is_non_informative; - mk_tac_step_3 0 "check_subtyping" #_ #RE.e_term #RE.e_term refl_check_subtyping refl_check_subtyping; - mk_tac_step_5 0 "t_check_equiv" #_ #_ #_ #RE.e_term #RE.e_term t_refl_check_equiv t_refl_check_equiv; - mk_tac_step_2 0 "core_compute_term_type" #_ #RE.e_term #(e_ret_t (e_tuple2 solve RE.e_term)) refl_core_compute_term_type refl_core_compute_term_type; - mk_tac_step_4 0 "core_check_term" #_ #RE.e_term #RE.e_term refl_core_check_term refl_core_check_term; - mk_tac_step_3 0 "core_check_term_at_type" #_ #RE.e_term #RE.e_term refl_core_check_term_at_type refl_core_check_term_at_type; - mk_tac_step_2 0 "tc_term" #_ #RE.e_term #(e_ret_t (e_tuple2 RE.e_term (e_tuple2 solve RE.e_term))) refl_tc_term refl_tc_term; - mk_tac_step_2 0 "universe_of" #_ #RE.e_term refl_universe_of refl_universe_of; - mk_tac_step_2 0 "check_prop_validity" #_ #RE.e_term refl_check_prop_validity refl_check_prop_validity; - mk_tac_step_4 0 "check_match_complete" #_ #RE.e_term #RE.e_term refl_check_match_complete refl_check_match_complete; + mk_tac_step_2 0 "is_non_informative" refl_is_non_informative refl_is_non_informative; + mk_tac_step_3 0 "check_subtyping" refl_check_subtyping refl_check_subtyping; + mk_tac_step_5 0 "t_check_equiv" t_refl_check_equiv t_refl_check_equiv; + mk_tac_step_2 0 "core_compute_term_type" refl_core_compute_term_type refl_core_compute_term_type; + mk_tac_step_4 0 "core_check_term" refl_core_check_term refl_core_check_term; + mk_tac_step_3 0 "core_check_term_at_type" refl_core_check_term_at_type refl_core_check_term_at_type; + mk_tac_step_2 0 "tc_term" refl_tc_term refl_tc_term; + mk_tac_step_2 0 "universe_of" refl_universe_of refl_universe_of; + mk_tac_step_2 0 "check_prop_validity" refl_check_prop_validity refl_check_prop_validity; + mk_tac_step_4 0 "check_match_complete" refl_check_match_complete refl_check_match_complete; mk_tac_step_2 0 "instantiate_implicits" #_ #_ #(e_ret_t (e_tuple3 (e_list (e_tuple2 RE.e_namedv solve)) solve solve)) #_ #_ #(nbe_e_ret_t (NBET.e_tuple3 (NBET.e_list (NBET.e_tuple2 NRE.e_namedv solve)) solve solve)) refl_instantiate_implicits refl_instantiate_implicits; mk_tac_step_4 0 "try_unify" - #RE.e_env #(e_list (e_tuple2 RE.e_namedv RE.e_term)) #RE.e_term #RE.e_term #(e_ret_t (e_list (e_tuple2 RE.e_namedv RE.e_term))) - #NRE.e_env #(NBET.e_list (NBET.e_tuple2 NRE.e_namedv NRE.e_term)) #NRE.e_term #NRE.e_term #(nbe_e_ret_t (NBET.e_list (NBET.e_tuple2 NRE.e_namedv NRE.e_term))) + #_ #(e_list (e_tuple2 RE.e_namedv RE.e_term)) #_ #_ #(e_ret_t (e_list (e_tuple2 RE.e_namedv RE.e_term))) + #_ #(NBET.e_list (NBET.e_tuple2 NRE.e_namedv NRE.e_term)) #_ #_ #(nbe_e_ret_t (NBET.e_list (NBET.e_tuple2 NRE.e_namedv NRE.e_term))) refl_try_unify refl_try_unify; mk_tac_step_3 0 "maybe_relate_after_unfolding" refl_maybe_relate_after_unfolding refl_maybe_relate_after_unfolding; mk_tac_step_2 0 "maybe_unfold_head" refl_maybe_unfold_head refl_maybe_unfold_head; From a755e4b750082d4d4998f1dcac1d71cf93b56ec1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 18 Apr 2024 14:04:58 -0700 Subject: [PATCH 031/239] snap --- .../generated/FStar_Tactics_InterpFuns.ml | 84 ++ .../generated/FStar_Tactics_V1_Basic.ml | 2 +- .../generated/FStar_Tactics_V2_Basic.ml | 229 +++--- .../generated/FStar_Tactics_V2_Derived.ml | 24 +- .../generated/FStar_Tactics_V2_Primops.ml | 151 ++-- .../generated/FStar_TypeChecker_Core.ml | 758 ++++++++++++------ .../FStar_TypeChecker_Primops_Base.ml | 301 ++++++- .../fstar-tests/generated/FStar_Tests_Unif.ml | 7 +- 8 files changed, 1139 insertions(+), 417 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_InterpFuns.ml b/ocaml/fstar-lib/generated/FStar_Tactics_InterpFuns.ml index c814b0d2302..fa15e66c967 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_InterpFuns.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_InterpFuns.ml @@ -371,6 +371,90 @@ let mk_tac_step_4 : FStar_Pervasives_Native.Some uu___11) in set_auto_reflect (Prims.of_int (4)) uu___10 +let mk_tac_step_5 : + 'nres 'nt1 'nt2 'nt3 'nt4 'nt5 'res 't1 't2 't3 't4 't5 . + Prims.int -> + Prims.string -> + 't1 FStar_Syntax_Embeddings_Base.embedding -> + 't2 FStar_Syntax_Embeddings_Base.embedding -> + 't3 FStar_Syntax_Embeddings_Base.embedding -> + 't4 FStar_Syntax_Embeddings_Base.embedding -> + 't5 FStar_Syntax_Embeddings_Base.embedding -> + 'res FStar_Syntax_Embeddings_Base.embedding -> + 'nt1 FStar_TypeChecker_NBETerm.embedding -> + 'nt2 FStar_TypeChecker_NBETerm.embedding -> + 'nt3 FStar_TypeChecker_NBETerm.embedding -> + 'nt4 FStar_TypeChecker_NBETerm.embedding -> + 'nt5 FStar_TypeChecker_NBETerm.embedding -> + 'nres FStar_TypeChecker_NBETerm.embedding -> + ('t1 -> + 't2 -> + 't3 -> + 't4 -> + 't5 -> 'res FStar_Tactics_Monad.tac) + -> + ('nt1 -> + 'nt2 -> + 'nt3 -> + 'nt4 -> + 'nt5 -> + 'nres FStar_Tactics_Monad.tac) + -> + FStar_TypeChecker_Primops_Base.primitive_step + = + fun univ_arity -> + fun nm -> + fun uu___ -> + fun uu___1 -> + fun uu___2 -> + fun uu___3 -> + fun uu___4 -> + fun uu___5 -> + fun uu___6 -> + fun uu___7 -> + fun uu___8 -> + fun uu___9 -> + fun uu___10 -> + fun uu___11 -> + fun f -> + fun nbe_f -> + let lid = builtin_lid nm in + let uu___12 = + FStar_TypeChecker_Primops_Base.mk6' + univ_arity lid uu___ uu___6 uu___1 + uu___7 uu___2 uu___8 uu___3 uu___9 + uu___4 uu___10 + FStar_Tactics_Embedding.e_proofstate + FStar_Tactics_Embedding.e_proofstate_nbe + (FStar_Tactics_Embedding.e_result + uu___5) + (FStar_Tactics_Embedding.e_result_nbe + uu___11) + (fun a -> + fun b -> + fun c -> + fun d -> + fun e -> + fun ps -> + let uu___13 = + let uu___14 = + f a b c d e in + run_wrap nm uu___14 ps in + FStar_Pervasives_Native.Some + uu___13) + (fun a -> + fun b -> + fun c -> + fun d -> + fun e -> + fun ps -> + let uu___13 = + let uu___14 = + nbe_f a b c d e in + run_wrap nm uu___14 ps in + FStar_Pervasives_Native.Some + uu___13) in + set_auto_reflect (Prims.of_int (5)) uu___12 let (max_tac_arity : Prims.int) = (Prims.of_int (20)) let mk_tactic_interpretation_1 : 'r 't1 . diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml index de22aaf32af..b1e575d08af 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml @@ -5418,7 +5418,7 @@ let (_t_trefl : | FStar_Pervasives.Inl (uu___13, t_ty) -> let uu___14 = FStar_TypeChecker_Core.check_term_subtyping - env1 ty t_ty in + true true env1 ty t_ty in (match uu___14 with | FStar_Pervasives.Inl (FStar_Pervasives_Native.None) -> diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml index c1d8061b37a..5c51f84018c 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml @@ -6004,7 +6004,7 @@ let (_t_trefl : | FStar_Pervasives.Inl (uu___13, t_ty) -> let uu___14 = FStar_TypeChecker_Core.check_term_subtyping - env1 ty t_ty in + true true env1 ty t_ty in (match uu___14 with | FStar_Pervasives.Inl (FStar_Pervasives_Native.None) -> @@ -9957,117 +9957,136 @@ let (refl_is_non_informative : FStar_Class_Monad.return FStar_Tactics_Monad.monad_tac () (Obj.magic uu___2)))) uu___1 uu___ let (refl_check_relation : - env -> - FStar_Syntax_Syntax.typ -> - FStar_Syntax_Syntax.typ -> - relation -> - (unit FStar_Pervasives_Native.option * issues) - FStar_Tactics_Monad.tac) + relation -> + Prims.bool -> + Prims.bool -> + env -> + FStar_Syntax_Syntax.typ -> + FStar_Syntax_Syntax.typ -> + (unit FStar_Pervasives_Native.option * issues) + FStar_Tactics_Monad.tac) = - fun uu___3 -> - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun g -> - fun t0 -> - fun t1 -> - fun rel -> - let uu___ = - ((no_uvars_in_g g) && (no_uvars_in_term t0)) && - (no_uvars_in_term t1) in - if uu___ - then - Obj.magic - (Obj.repr - (refl_typing_builtin_wrapper "refl_check_relation" - (fun uu___1 -> - let g1 = - FStar_TypeChecker_Env.set_range g - t0.FStar_Syntax_Syntax.pos in - dbg_refl g1 - (fun uu___3 -> - let uu___4 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term t0 in - let uu___5 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term t1 in - FStar_Compiler_Util.format3 - "refl_check_relation: %s %s %s\n" - uu___4 - (if rel = Subtyping - then "<:?" - else "=?=") uu___5); - (let f = - if rel = Subtyping - then - FStar_TypeChecker_Core.check_term_subtyping - else - FStar_TypeChecker_Core.check_term_equality in - let uu___3 = f g1 t0 t1 in - match uu___3 with - | FStar_Pervasives.Inl - (FStar_Pervasives_Native.None) -> - (dbg_refl g1 - (fun uu___5 -> - "refl_check_relation: succeeded (no guard)"); - ((), [])) - | FStar_Pervasives.Inl - (FStar_Pervasives_Native.Some guard_f) - -> - (dbg_refl g1 - (fun uu___5 -> - "refl_check_relation: succeeded"); - ((), [(g1, guard_f)])) - | FStar_Pervasives.Inr err -> - (dbg_refl g1 - (fun uu___5 -> - let uu___6 = - FStar_TypeChecker_Core.print_error - err in - FStar_Compiler_Util.format1 - "refl_check_relation failed: %s\n" - uu___6); - (let uu___5 = - let uu___6 = - let uu___7 = - FStar_TypeChecker_Core.print_error - err in - Prims.strcat - "check_relation failed: " uu___7 in - (FStar_Errors_Codes.Fatal_IllTyped, - uu___6) in - let uu___6 = - FStar_TypeChecker_Env.get_range g1 in - FStar_Errors.raise_error uu___5 uu___6)))))) - else - Obj.magic - (Obj.repr - (let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - FStar_TypeChecker_Env.get_range g in - unexpected_uvars_issue uu___5 in - [uu___4] in - (FStar_Pervasives_Native.None, uu___3) in - FStar_Class_Monad.return - FStar_Tactics_Monad.monad_tac () - (Obj.magic uu___2)))) uu___3 uu___2 uu___1 uu___ + fun uu___5 -> + fun uu___4 -> + fun uu___3 -> + fun uu___2 -> + fun uu___1 -> + fun uu___ -> + (fun rel -> + fun smt_ok -> + fun unfolding_ok -> + fun g -> + fun t0 -> + fun t1 -> + let uu___ = + ((no_uvars_in_g g) && (no_uvars_in_term t0)) && + (no_uvars_in_term t1) in + if uu___ + then + Obj.magic + (Obj.repr + (refl_typing_builtin_wrapper + "refl_check_relation" + (fun uu___1 -> + let g1 = + FStar_TypeChecker_Env.set_range g + t0.FStar_Syntax_Syntax.pos in + dbg_refl g1 + (fun uu___3 -> + let uu___4 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + t0 in + let uu___5 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + t1 in + FStar_Compiler_Util.format3 + "refl_check_relation: %s %s %s\n" + uu___4 + (if rel = Subtyping + then "<:?" + else "=?=") uu___5); + (let f = + if rel = Subtyping + then + FStar_TypeChecker_Core.check_term_subtyping + else + FStar_TypeChecker_Core.check_term_equality in + let uu___3 = + f smt_ok unfolding_ok g1 t0 t1 in + match uu___3 with + | FStar_Pervasives.Inl + (FStar_Pervasives_Native.None) + -> + (dbg_refl g1 + (fun uu___5 -> + "refl_check_relation: succeeded (no guard)"); + ((), [])) + | FStar_Pervasives.Inl + (FStar_Pervasives_Native.Some + guard_f) -> + (dbg_refl g1 + (fun uu___5 -> + "refl_check_relation: succeeded"); + ((), [(g1, guard_f)])) + | FStar_Pervasives.Inr err -> + (dbg_refl g1 + (fun uu___5 -> + let uu___6 = + FStar_TypeChecker_Core.print_error + err in + FStar_Compiler_Util.format1 + "refl_check_relation failed: %s\n" + uu___6); + (let uu___5 = + let uu___6 = + let uu___7 = + FStar_TypeChecker_Core.print_error + err in + Prims.strcat + "check_relation failed: " + uu___7 in + (FStar_Errors_Codes.Fatal_IllTyped, + uu___6) in + let uu___6 = + FStar_TypeChecker_Env.get_range + g1 in + FStar_Errors.raise_error + uu___5 uu___6)))))) + else + Obj.magic + (Obj.repr + (let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = + FStar_TypeChecker_Env.get_range g in + unexpected_uvars_issue uu___5 in + [uu___4] in + (FStar_Pervasives_Native.None, uu___3) in + FStar_Class_Monad.return + FStar_Tactics_Monad.monad_tac () + (Obj.magic uu___2)))) uu___5 uu___4 + uu___3 uu___2 uu___1 uu___ let (refl_check_subtyping : env -> FStar_Syntax_Syntax.typ -> FStar_Syntax_Syntax.typ -> (unit FStar_Pervasives_Native.option * issues) FStar_Tactics_Monad.tac) - = fun g -> fun t0 -> fun t1 -> refl_check_relation g t0 t1 Subtyping -let (refl_check_equiv : - env -> - FStar_Syntax_Syntax.typ -> - FStar_Syntax_Syntax.typ -> - (unit FStar_Pervasives_Native.option * issues) - FStar_Tactics_Monad.tac) - = fun g -> fun t0 -> fun t1 -> refl_check_relation g t0 t1 Equality + = + fun g -> + fun t0 -> fun t1 -> refl_check_relation Subtyping true true g t0 t1 +let (t_refl_check_equiv : + Prims.bool -> + Prims.bool -> + env -> + FStar_Syntax_Syntax.typ -> + FStar_Syntax_Syntax.typ -> + (unit FStar_Pervasives_Native.option * issues) + FStar_Tactics_Monad.tac) + = refl_check_relation Equality let (to_must_tot : FStar_TypeChecker_Core.tot_or_ghost -> Prims.bool) = fun eff -> match eff with diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Derived.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Derived.ml index 2e2a41e9b6f..af3561abadb 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Derived.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Derived.ml @@ -5340,4 +5340,26 @@ let (smt_sync' : (fun vcfg' -> Obj.magic (FStar_Tactics_V2_Builtins.t_smt_sync vcfg')) - uu___))) uu___) \ No newline at end of file + uu___))) uu___) +let (check_equiv : + FStar_Reflection_Types.env -> + FStar_Reflection_Types.typ -> + FStar_Reflection_Types.typ -> + (((unit, unit, unit) FStar_Tactics_Types.equiv_token + FStar_Pervasives_Native.option * FStar_Issue.issue Prims.list), + unit) FStar_Tactics_Effect.tac_repr) + = + fun g -> + fun t0 -> + fun t1 -> FStar_Tactics_V2_Builtins.t_check_equiv true true g t0 t1 +let (check_equiv_nosmt : + FStar_Reflection_Types.env -> + FStar_Reflection_Types.typ -> + FStar_Reflection_Types.typ -> + (((unit, unit, unit) FStar_Tactics_Types.equiv_token + FStar_Pervasives_Native.option * FStar_Issue.issue Prims.list), + unit) FStar_Tactics_Effect.tac_repr) + = + fun g -> + fun t0 -> + fun t1 -> FStar_Tactics_V2_Builtins.t_check_equiv false false g t0 t1 \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Primops.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Primops.ml index 56661c063a0..487bf630c30 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Primops.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Primops.ml @@ -127,8 +127,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = let uu___14 = let uu___15 = FStar_Tactics_InterpFuns.mk_tot_step_1 Prims.int_zero - "goal_type" FStar_Tactics_Embedding.e_goal - FStar_Reflection_V2_Embeddings.e_term + "goal_type" FStar_Tactics_Embedding.e_goal uu___2 FStar_Tactics_Embedding.e_goal_nbe FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Tactics_Types.goal_type @@ -136,8 +135,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = let uu___16 = let uu___17 = FStar_Tactics_InterpFuns.mk_tot_step_1 Prims.int_zero - "goal_witness" FStar_Tactics_Embedding.e_goal - FStar_Reflection_V2_Embeddings.e_term + "goal_witness" FStar_Tactics_Embedding.e_goal uu___2 FStar_Tactics_Embedding.e_goal_nbe FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Tactics_Types.goal_witness @@ -176,9 +174,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = let uu___25 = let uu___26 = FStar_Tactics_InterpFuns.mk_tac_step_1 - Prims.int_zero "compress" - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + Prims.int_zero "compress" uu___2 uu___2 FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Tactics_V2_Basic.compress @@ -296,8 +292,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Reflection_V2_Embeddings.e_env (FStar_Syntax_Embeddings.e_list FStar_Syntax_Embeddings.e_norm_step) - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 uu___2 FStar_Reflection_V2_NBEEmbeddings.e_env (FStar_TypeChecker_NBETerm.e_list FStar_TypeChecker_NBETerm.e_norm_step) @@ -406,7 +401,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = "t_exact" FStar_Syntax_Embeddings.e_bool FStar_Syntax_Embeddings.e_bool - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Syntax_Embeddings.e_unit FStar_TypeChecker_NBETerm.e_bool FStar_TypeChecker_NBETerm.e_bool @@ -422,7 +417,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Syntax_Embeddings.e_bool FStar_Syntax_Embeddings.e_bool FStar_Syntax_Embeddings.e_bool - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Syntax_Embeddings.e_unit FStar_TypeChecker_NBETerm.e_bool FStar_TypeChecker_NBETerm.e_bool @@ -439,7 +434,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = "t_apply_lemma" FStar_Syntax_Embeddings.e_bool FStar_Syntax_Embeddings.e_bool - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Syntax_Embeddings.e_unit FStar_TypeChecker_NBETerm.e_bool FStar_TypeChecker_NBETerm.e_bool @@ -468,7 +463,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "tcc" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Reflection_V2_Embeddings.e_comp FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute @@ -483,8 +478,8 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "tc" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Reflection_V2_NBEEmbeddings.e_attribute @@ -497,7 +492,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero "unshelve" - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Syntax_Embeddings.e_unit FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_TypeChecker_NBETerm.e_unit @@ -692,7 +687,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero "tadmit_t" - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Syntax_Embeddings.e_unit FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_TypeChecker_NBETerm.e_unit @@ -718,7 +713,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero "t_destruct" - FStar_Reflection_V2_Embeddings.e_term + uu___2 (FStar_Syntax_Embeddings.e_list (FStar_Syntax_Embeddings.e_tuple2 FStar_Reflection_V2_Embeddings.e_fv @@ -778,8 +773,8 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = "uvar_env" FStar_Reflection_V2_Embeddings.e_env (FStar_Syntax_Embeddings.e_option - FStar_Reflection_V2_Embeddings.e_term) - FStar_Reflection_V2_Embeddings.e_term + uu___2) + uu___2 FStar_Reflection_V2_NBEEmbeddings.e_env (FStar_TypeChecker_NBETerm.e_option FStar_Reflection_V2_NBEEmbeddings.e_attribute) @@ -794,8 +789,8 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "ghost_uvar_env" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Reflection_V2_NBEEmbeddings.e_attribute @@ -809,7 +804,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "fresh_universe_uvar" FStar_Syntax_Embeddings.e_unit - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_TypeChecker_NBETerm.e_unit FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Tactics_V2_Basic.fresh_universe_uvar @@ -822,8 +817,8 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "unify_env" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 FStar_Syntax_Embeddings.e_bool FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute @@ -839,8 +834,8 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "unify_guard_env" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 FStar_Syntax_Embeddings.e_bool FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute @@ -856,8 +851,8 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "match_env" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 FStar_Syntax_Embeddings.e_bool FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute @@ -889,7 +884,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero "change" - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Syntax_Embeddings.e_unit FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_TypeChecker_NBETerm.e_unit @@ -1031,7 +1026,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = "string_to_term" FStar_Reflection_V2_Embeddings.e_env FStar_Syntax_Embeddings.e_string - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Reflection_V2_NBEEmbeddings.e_env FStar_TypeChecker_NBETerm.e_string FStar_Reflection_V2_NBEEmbeddings.e_attribute @@ -1063,7 +1058,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero "term_to_string" - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Syntax_Embeddings.e_string FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_TypeChecker_NBETerm.e_string @@ -1089,7 +1084,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero "term_to_doc" - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Syntax_Embeddings.e_document FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_TypeChecker_NBETerm.e_document @@ -1128,8 +1123,8 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero "term_eq_old" - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 FStar_Syntax_Embeddings.e_bool FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Reflection_V2_NBEEmbeddings.e_attribute @@ -1213,7 +1208,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero "free_uvars" - FStar_Reflection_V2_Embeddings.e_term + uu___2 (FStar_Syntax_Embeddings.e_list FStar_Syntax_Embeddings.e_int) FStar_Reflection_V2_NBEEmbeddings.e_attribute @@ -1351,7 +1346,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "is_non_informative" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term + uu___2 (FStar_Syntax_Embeddings.e_tuple2 (FStar_Syntax_Embeddings.e_option FStar_Syntax_Embeddings.e_unit) @@ -1374,8 +1369,8 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "check_subtyping" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 (FStar_Syntax_Embeddings.e_tuple2 (FStar_Syntax_Embeddings.e_option FStar_Syntax_Embeddings.e_unit) @@ -1395,17 +1390,21 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = = let uu___182 = - FStar_Tactics_InterpFuns.mk_tac_step_3 + FStar_Tactics_InterpFuns.mk_tac_step_5 Prims.int_zero - "check_equiv" + "t_check_equiv" + FStar_Syntax_Embeddings.e_bool + FStar_Syntax_Embeddings.e_bool FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 (FStar_Syntax_Embeddings.e_tuple2 (FStar_Syntax_Embeddings.e_option FStar_Syntax_Embeddings.e_unit) (FStar_Syntax_Embeddings.e_list FStar_Syntax_Embeddings.e_issue)) + FStar_TypeChecker_NBETerm.e_bool + FStar_TypeChecker_NBETerm.e_bool FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Reflection_V2_NBEEmbeddings.e_attribute @@ -1414,25 +1413,24 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_unit) (FStar_TypeChecker_NBETerm.e_list FStar_TypeChecker_NBETerm.e_issue)) - FStar_Tactics_V2_Basic.refl_check_equiv - FStar_Tactics_V2_Basic.refl_check_equiv in + FStar_Tactics_V2_Basic.t_refl_check_equiv + FStar_Tactics_V2_Basic.t_refl_check_equiv in let uu___183 = let uu___184 = - let uu___185 - = - e_ret_t - (FStar_Syntax_Embeddings.e_tuple2 - (solve - FStar_Tactics_Embedding.e_tot_or_ghost) - FStar_Reflection_V2_Embeddings.e_term) in FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero "core_compute_term_type" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - uu___185 + uu___2 + (FStar_Syntax_Embeddings.e_tuple2 + (FStar_Syntax_Embeddings.e_option + (FStar_Syntax_Embeddings.e_tuple2 + FStar_Tactics_Embedding.e_tot_or_ghost + uu___2)) + (FStar_Syntax_Embeddings.e_list + FStar_Syntax_Embeddings.e_issue)) FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute (FStar_TypeChecker_NBETerm.e_tuple2 @@ -1452,8 +1450,8 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "core_check_term" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 FStar_Tactics_Embedding.e_tot_or_ghost (FStar_Syntax_Embeddings.e_tuple2 (FStar_Syntax_Embeddings.e_option @@ -1479,8 +1477,8 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "core_check_term_at_type" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 (FStar_Syntax_Embeddings.e_tuple2 (FStar_Syntax_Embeddings.e_option FStar_Tactics_Embedding.e_tot_or_ghost) @@ -1500,21 +1498,20 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = = let uu___190 = - let uu___191 - = - e_ret_t - (FStar_Syntax_Embeddings.e_tuple2 - FStar_Reflection_V2_Embeddings.e_term - (FStar_Syntax_Embeddings.e_tuple2 - (solve - FStar_Tactics_Embedding.e_tot_or_ghost) - FStar_Reflection_V2_Embeddings.e_term)) in FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero "tc_term" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - uu___191 + uu___2 + (FStar_Syntax_Embeddings.e_tuple2 + (FStar_Syntax_Embeddings.e_option + (FStar_Syntax_Embeddings.e_tuple2 + uu___2 + (FStar_Syntax_Embeddings.e_tuple2 + FStar_Tactics_Embedding.e_tot_or_ghost + uu___2))) + (FStar_Syntax_Embeddings.e_list + FStar_Syntax_Embeddings.e_issue)) FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute (FStar_TypeChecker_NBETerm.e_tuple2 @@ -1536,7 +1533,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "universe_of" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term + uu___2 (FStar_Syntax_Embeddings.e_tuple2 (FStar_Syntax_Embeddings.e_option FStar_Reflection_V2_Embeddings.e_universe) @@ -1559,7 +1556,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "check_prop_validity" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term + uu___2 (FStar_Syntax_Embeddings.e_tuple2 (FStar_Syntax_Embeddings.e_option FStar_Syntax_Embeddings.e_unit) @@ -1582,8 +1579,8 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "check_match_complete" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 (FStar_Syntax_Embeddings.e_list FStar_Reflection_V2_Embeddings.e_pattern) (FStar_Syntax_Embeddings.e_option @@ -1674,16 +1671,16 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = (FStar_Syntax_Embeddings.e_tuple2 FStar_Reflection_V2_Embeddings.e_namedv FStar_Reflection_V2_Embeddings.e_term)) - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 uu___201 FStar_Reflection_V2_NBEEmbeddings.e_env (FStar_TypeChecker_NBETerm.e_list (FStar_TypeChecker_NBETerm.e_tuple2 FStar_Reflection_V2_NBEEmbeddings.e_namedv FStar_Reflection_V2_NBEEmbeddings.e_term)) - FStar_Reflection_V2_NBEEmbeddings.e_term - FStar_Reflection_V2_NBEEmbeddings.e_term + FStar_Reflection_V2_NBEEmbeddings.e_attribute + FStar_Reflection_V2_NBEEmbeddings.e_attribute uu___202 FStar_Tactics_V2_Basic.refl_try_unify FStar_Tactics_V2_Basic.refl_try_unify in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml index bfeaa3b68b4..b13f18135fb 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml @@ -390,17 +390,24 @@ let (context_term_to_string : context_term -> Prims.string) = type context = { no_guard: Prims.bool ; + unfolding_ok: Prims.bool ; error_context: (Prims.string * context_term FStar_Pervasives_Native.option) Prims.list } let (__proj__Mkcontext__item__no_guard : context -> Prims.bool) = fun projectee -> - match projectee with | { no_guard; error_context;_} -> no_guard + match projectee with + | { no_guard; unfolding_ok; error_context;_} -> no_guard +let (__proj__Mkcontext__item__unfolding_ok : context -> Prims.bool) = + fun projectee -> + match projectee with + | { no_guard; unfolding_ok; error_context;_} -> unfolding_ok let (__proj__Mkcontext__item__error_context : context -> (Prims.string * context_term FStar_Pervasives_Native.option) Prims.list) = fun projectee -> - match projectee with | { no_guard; error_context;_} -> error_context + match projectee with + | { no_guard; unfolding_ok; error_context;_} -> error_context let (showable_context : context FStar_Class_Show.showable) = { FStar_Class_Show.show = @@ -410,15 +417,20 @@ let (showable_context : context FStar_Class_Show.showable) = (FStar_Class_Show.printableshow FStar_Class_Printable.printable_bool) context1.no_guard in let uu___1 = - let uu___2 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) context1.unfolding_ok in + let uu___2 = + let uu___3 = FStar_Compiler_List.map FStar_Pervasives_Native.fst context1.error_context in FStar_Class_Show.show (FStar_Class_Show.show_list (FStar_Class_Show.printableshow - FStar_Class_Printable.printable_string)) uu___2 in - FStar_Compiler_Util.format2 "{no_guard=%s, error_context=%s}" uu___ - uu___1) + FStar_Class_Printable.printable_string)) uu___3 in + FStar_Compiler_Util.format3 + "{no_guard=%s; unfolding_ok=%s; error_context=%s}" uu___ uu___1 + uu___2) } let (print_context : context -> Prims.string) = fun ctx -> @@ -668,6 +680,7 @@ let with_context : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = ((msg, t) :: (ctx.error_context)) } in let uu___ = x () in uu___ ctx1 @@ -698,6 +711,7 @@ let (is_type : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("is_type", (FStar_Pervasives_Native.Some (CtxTerm t))) :: (ctx.error_context)) @@ -865,6 +879,7 @@ let rec (is_arrow : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("is_arrow", FStar_Pervasives_Native.None) :: (ctx.error_context)) } in @@ -1146,7 +1161,13 @@ let strengthen : let no_guard : 'a . 'a result -> 'a result = fun g -> fun ctx -> - let uu___ = g { no_guard = true; error_context = (ctx.error_context) } in + let uu___ = + g + { + no_guard = true; + unfolding_ok = (ctx.unfolding_ok); + error_context = (ctx.error_context) + } in match uu___ with | Success (x, FStar_Pervasives_Native.None) -> Success (x, FStar_Pervasives_Native.None) @@ -1571,6 +1592,8 @@ let (join_eff_l : tot_or_ghost Prims.list -> tot_or_ghost) = fun es -> FStar_List_Tot_Base.fold_right join_eff es E_Total let (guard_not_allowed : Prims.bool result) = fun ctx -> Success ((ctx.no_guard), FStar_Pervasives_Native.None) +let (unfolding_ok : Prims.bool result) = + fun ctx -> Success ((ctx.unfolding_ok), FStar_Pervasives_Native.None) let (debug : env -> (unit -> unit) -> unit) = fun g -> fun f -> @@ -1793,11 +1816,45 @@ let rec (check_relation : | uu___6 -> FStar_Pervasives_Native.None)) FStar_Pervasives_Native.None "FStar.TypeChecker.Core.maybe_unfold_side" in - let maybe_unfold t01 t11 = - let uu___4 = which_side_to_unfold t01 t11 in - maybe_unfold_side uu___4 t01 t11 in + let maybe_unfold t01 t11 ctx01 = + let uu___4 = unfolding_ok ctx01 in + match uu___4 with + | Success (x1, g11) -> + let uu___5 = + let uu___6 = + if x1 + then + let uu___7 = + let uu___8 = which_side_to_unfold t01 t11 in + maybe_unfold_side uu___8 t01 t11 in + fun uu___8 -> + Success + (uu___7, FStar_Pervasives_Native.None) + else + (fun uu___8 -> + Success + (FStar_Pervasives_Native.None, + FStar_Pervasives_Native.None)) in + uu___6 ctx01 in + (match uu___5 with + | Success (y, g2) -> + let uu___6 = + let uu___7 = and_pre g11 g2 in (y, uu___7) in + Success uu___6 + | err1 -> err1) + | Error err1 -> Error err1 in let emit_guard t01 t11 = - let uu___4 = do_check g t01 in + let uu___4 ctx = + let ctx1 = + { + no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); + error_context = + (("checking lhs while emitting guard", + FStar_Pervasives_Native.None) :: + (ctx.error_context)) + } in + let uu___5 = do_check g t01 in uu___5 ctx1 in fun ctx01 -> let uu___5 = uu___4 ctx01 in match uu___5 with @@ -1842,43 +1899,45 @@ let rec (check_relation : let uu___4 = (equatable g t01) || (equatable g t11) in (if uu___4 then emit_guard t01 t11 else err ()) else err () in - let maybe_unfold_side_and_retry side1 t01 t11 = - let uu___4 = maybe_unfold_side side1 t01 t11 in + let maybe_unfold_side_and_retry side1 t01 t11 ctx01 = + let uu___4 = unfolding_ok ctx01 in match uu___4 with - | FStar_Pervasives_Native.None -> fallback t01 t11 - | FStar_Pervasives_Native.Some (t02, t12) -> - check_relation g rel t02 t12 in + | Success (x1, g11) -> + let uu___5 = + let uu___6 = + if x1 + then + let uu___7 = maybe_unfold_side side1 t01 t11 in + match uu___7 with + | FStar_Pervasives_Native.None -> + fallback t01 t11 + | FStar_Pervasives_Native.Some (t02, t12) -> + check_relation g rel t02 t12 + else fallback t01 t11 in + uu___6 ctx01 in + (match uu___5 with + | Success (y, g2) -> + let uu___6 = + let uu___7 = and_pre g11 g2 in ((), uu___7) in + Success uu___6 + | err1 -> err1) + | Error err1 -> Error err1 in let maybe_unfold_and_retry t01 t11 = let uu___4 = which_side_to_unfold t01 t11 in maybe_unfold_side_and_retry uu___4 t01 t11 in let beta_iota_reduce t = let t2 = FStar_Syntax_Subst.compress t in - match t2.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_app uu___4 -> - let head = FStar_Syntax_Util.leftmost_head t2 in - let uu___5 = - let uu___6 = FStar_Syntax_Subst.compress head in - uu___6.FStar_Syntax_Syntax.n in - (match uu___5 with - | FStar_Syntax_Syntax.Tm_abs uu___6 -> - FStar_TypeChecker_Normalize.normalize - [FStar_TypeChecker_Env.Beta; - FStar_TypeChecker_Env.Iota; - FStar_TypeChecker_Env.Primops] g.tcenv t2 - | uu___6 -> t2) - | FStar_Syntax_Syntax.Tm_let uu___4 -> - FStar_TypeChecker_Normalize.normalize - [FStar_TypeChecker_Env.Beta; - FStar_TypeChecker_Env.Iota; - FStar_TypeChecker_Env.Primops] g.tcenv t2 - | FStar_Syntax_Syntax.Tm_match uu___4 -> - FStar_TypeChecker_Normalize.normalize - [FStar_TypeChecker_Env.Beta; - FStar_TypeChecker_Env.Iota; - FStar_TypeChecker_Env.Primops] g.tcenv t2 + let t3 = + FStar_TypeChecker_Normalize.normalize + [FStar_TypeChecker_Env.HNF; + FStar_TypeChecker_Env.Weak; + FStar_TypeChecker_Env.Beta; + FStar_TypeChecker_Env.Iota; + FStar_TypeChecker_Env.Primops] g.tcenv t2 in + match t3.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_refine uu___4 -> - FStar_Syntax_Util.flatten_refinement t2 - | uu___4 -> t2 in + FStar_Syntax_Util.flatten_refinement t3 + | uu___4 -> t3 in let beta_iota_reduce1 t = FStar_Profiling.profile (fun uu___4 -> beta_iota_reduce t) @@ -1898,6 +1957,7 @@ let rec (check_relation : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("check_relation", (FStar_Pervasives_Native.Some @@ -2177,45 +2237,91 @@ let rec (check_relation : (let uu___8 = maybe_unfold x0.FStar_Syntax_Syntax.sort x1.FStar_Syntax_Syntax.sort in - match uu___8 with - | FStar_Pervasives_Native.None -> - fallback t01 t11 - | FStar_Pervasives_Native.Some (t02, t12) -> - let lhs = - FStar_Syntax_Syntax.mk - (FStar_Syntax_Syntax.Tm_refine - { - FStar_Syntax_Syntax.b = - { - FStar_Syntax_Syntax.ppname = - (x0.FStar_Syntax_Syntax.ppname); - FStar_Syntax_Syntax.index = - (x0.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = - t02 - }; - FStar_Syntax_Syntax.phi = f0 - }) t02.FStar_Syntax_Syntax.pos in - let rhs = - FStar_Syntax_Syntax.mk - (FStar_Syntax_Syntax.Tm_refine - { - FStar_Syntax_Syntax.b = - { - FStar_Syntax_Syntax.ppname = - (x1.FStar_Syntax_Syntax.ppname); - FStar_Syntax_Syntax.index = - (x1.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = - t12 - }; - FStar_Syntax_Syntax.phi = f1 - }) t12.FStar_Syntax_Syntax.pos in - let uu___9 = - FStar_Syntax_Util.flatten_refinement lhs in - let uu___10 = - FStar_Syntax_Util.flatten_refinement rhs in - check_relation1 g rel uu___9 uu___10) + fun ctx01 -> + let uu___9 = uu___8 ctx01 in + match uu___9 with + | Success (x2, g11) -> + let uu___10 = + let uu___11 = + match x2 with + | FStar_Pervasives_Native.None -> + ((let uu___13 = + FStar_TypeChecker_Env.debug + g.tcenv + (FStar_Options.Other + "Core") in + if uu___13 + then + let uu___14 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + x0.FStar_Syntax_Syntax.sort in + let uu___15 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + x1.FStar_Syntax_Syntax.sort in + FStar_Compiler_Util.print2 + "Cannot match ref heads %s and %s\n" + uu___14 uu___15 + else ()); + fallback t01 t11) + | FStar_Pervasives_Native.Some + (t02, t12) -> + let lhs = + FStar_Syntax_Syntax.mk + (FStar_Syntax_Syntax.Tm_refine + { + FStar_Syntax_Syntax.b = + { + FStar_Syntax_Syntax.ppname + = + (x0.FStar_Syntax_Syntax.ppname); + FStar_Syntax_Syntax.index + = + (x0.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort + = t02 + }; + FStar_Syntax_Syntax.phi + = f0 + }) + t02.FStar_Syntax_Syntax.pos in + let rhs = + FStar_Syntax_Syntax.mk + (FStar_Syntax_Syntax.Tm_refine + { + FStar_Syntax_Syntax.b = + { + FStar_Syntax_Syntax.ppname + = + (x1.FStar_Syntax_Syntax.ppname); + FStar_Syntax_Syntax.index + = + (x1.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort + = t12 + }; + FStar_Syntax_Syntax.phi + = f1 + }) + t12.FStar_Syntax_Syntax.pos in + let uu___12 = + FStar_Syntax_Util.flatten_refinement + lhs in + let uu___13 = + FStar_Syntax_Util.flatten_refinement + rhs in + check_relation1 g rel uu___12 + uu___13 in + uu___11 ctx01 in + (match uu___10 with + | Success (y, g2) -> + let uu___11 = + let uu___12 = and_pre g11 g2 in + ((), uu___12) in + Success uu___11 + | err1 -> err1) + | Error err1 -> Error err1) | (FStar_Syntax_Syntax.Tm_refine { FStar_Syntax_Syntax.b = x0; FStar_Syntax_Syntax.phi = f0;_}, @@ -2229,28 +2335,50 @@ let rec (check_relation : else (let uu___9 = maybe_unfold x0.FStar_Syntax_Syntax.sort t11 in - match uu___9 with - | FStar_Pervasives_Native.None -> - fallback t01 t11 - | FStar_Pervasives_Native.Some (t02, t12) -> - let lhs = - FStar_Syntax_Syntax.mk - (FStar_Syntax_Syntax.Tm_refine - { - FStar_Syntax_Syntax.b = - { - FStar_Syntax_Syntax.ppname = - (x0.FStar_Syntax_Syntax.ppname); - FStar_Syntax_Syntax.index = - (x0.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = - t02 - }; - FStar_Syntax_Syntax.phi = f0 - }) t02.FStar_Syntax_Syntax.pos in - let uu___10 = - FStar_Syntax_Util.flatten_refinement lhs in - check_relation1 g rel uu___10 t12) + fun ctx01 -> + let uu___10 = uu___9 ctx01 in + match uu___10 with + | Success (x1, g11) -> + let uu___11 = + let uu___12 = + match x1 with + | FStar_Pervasives_Native.None -> + fallback t01 t11 + | FStar_Pervasives_Native.Some + (t02, t12) -> + let lhs = + FStar_Syntax_Syntax.mk + (FStar_Syntax_Syntax.Tm_refine + { + FStar_Syntax_Syntax.b = + { + FStar_Syntax_Syntax.ppname + = + (x0.FStar_Syntax_Syntax.ppname); + FStar_Syntax_Syntax.index + = + (x0.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort + = t02 + }; + FStar_Syntax_Syntax.phi + = f0 + }) + t02.FStar_Syntax_Syntax.pos in + let uu___13 = + FStar_Syntax_Util.flatten_refinement + lhs in + check_relation1 g rel uu___13 + t12 in + uu___12 ctx01 in + (match uu___11 with + | Success (y, g2) -> + let uu___12 = + let uu___13 = and_pre g11 g2 in + ((), uu___13) in + Success uu___12 + | err1 -> err1) + | Error err1 -> Error err1) | (uu___6, FStar_Syntax_Syntax.Tm_refine { FStar_Syntax_Syntax.b = x1; FStar_Syntax_Syntax.phi = f1;_}) @@ -2411,28 +2539,50 @@ let rec (check_relation : else (let uu___9 = maybe_unfold t01 x1.FStar_Syntax_Syntax.sort in - match uu___9 with - | FStar_Pervasives_Native.None -> - fallback t01 t11 - | FStar_Pervasives_Native.Some (t02, t12) -> - let rhs = - FStar_Syntax_Syntax.mk - (FStar_Syntax_Syntax.Tm_refine - { - FStar_Syntax_Syntax.b = - { - FStar_Syntax_Syntax.ppname = - (x1.FStar_Syntax_Syntax.ppname); - FStar_Syntax_Syntax.index = - (x1.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = - t12 - }; - FStar_Syntax_Syntax.phi = f1 - }) t12.FStar_Syntax_Syntax.pos in - let uu___10 = - FStar_Syntax_Util.flatten_refinement rhs in - check_relation1 g rel t02 uu___10) + fun ctx01 -> + let uu___10 = uu___9 ctx01 in + match uu___10 with + | Success (x2, g11) -> + let uu___11 = + let uu___12 = + match x2 with + | FStar_Pervasives_Native.None -> + fallback t01 t11 + | FStar_Pervasives_Native.Some + (t02, t12) -> + let rhs = + FStar_Syntax_Syntax.mk + (FStar_Syntax_Syntax.Tm_refine + { + FStar_Syntax_Syntax.b = + { + FStar_Syntax_Syntax.ppname + = + (x1.FStar_Syntax_Syntax.ppname); + FStar_Syntax_Syntax.index + = + (x1.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort + = t12 + }; + FStar_Syntax_Syntax.phi + = f1 + }) + t12.FStar_Syntax_Syntax.pos in + let uu___13 = + FStar_Syntax_Util.flatten_refinement + rhs in + check_relation1 g rel t02 + uu___13 in + uu___12 ctx01 in + (match uu___11 with + | Success (y, g2) -> + let uu___12 = + let uu___13 = and_pre g11 g2 in + ((), uu___13) in + Success uu___12 + | err1 -> err1) + | Error err1 -> Error err1) | (FStar_Syntax_Syntax.Tm_uinst uu___6, uu___7) -> let head_matches1 = head_matches t01 t11 in let uu___8 = @@ -3038,6 +3188,7 @@ let rec (check_relation : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("subtype arrow", FStar_Pervasives_Native.None) :: @@ -3183,6 +3334,9 @@ let rec (check_relation : no_guard = (ctx2.no_guard); + unfolding_ok + = + (ctx2.unfolding_ok); error_context = (("check_subcomp", @@ -3314,13 +3468,27 @@ let rec (check_relation : match uu___19 with | Success (x1, g11) -> let uu___20 = - let uu___21 = + let uu___21 ctx = + let ctx1 = + { + no_guard = + (ctx.no_guard); + unfolding_ok = + (ctx.unfolding_ok); + error_context = + (("relate_branch", + FStar_Pervasives_Native.None) + :: + (ctx.error_context)) + } in let uu___22 = - check_relation1 g' - rel body01 - body11 in - with_binders bs0 x1 - uu___22 in + let uu___23 = + check_relation1 + g' rel body01 + body11 in + with_binders bs0 + x1 uu___23 in + uu___22 ctx1 in uu___21 ctx01 in (match uu___20 with | Success (y, g2) -> @@ -3587,6 +3755,7 @@ and (check_subtype : let ctx2 = { no_guard = (ctx1.no_guard); + unfolding_ok = (ctx1.unfolding_ok); error_context = (((if ctx.no_guard then "check_subtype(no_guard)" @@ -3660,6 +3829,7 @@ and (check : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = ((msg, (FStar_Pervasives_Native.Some (CtxTerm e))) :: (ctx.error_context)) @@ -3895,6 +4065,7 @@ and (do_check : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("abs binders", FStar_Pervasives_Native.None) :: (ctx.error_context)) @@ -3950,6 +4121,7 @@ and (do_check : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("arrow binders", FStar_Pervasives_Native.None) :: (ctx.error_context)) @@ -3966,6 +4138,7 @@ and (do_check : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("arrow comp", FStar_Pervasives_Native.None) :: @@ -4032,6 +4205,8 @@ and (do_check : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = + (ctx.unfolding_ok); error_context = (("app subtyping", FStar_Pervasives_Native.None) @@ -4054,6 +4229,8 @@ and (do_check : { no_guard = (ctx.no_guard); + unfolding_ok = + (ctx.unfolding_ok); error_context = (("app arg qual", @@ -4204,6 +4381,9 @@ and (do_check : no_guard = (ctx.no_guard); + unfolding_ok + = + (ctx.unfolding_ok); error_context = (("operator arg1", @@ -4325,6 +4505,9 @@ and (do_check : no_guard = (ctx.no_guard); + unfolding_ok + = + (ctx.unfolding_ok); error_context = (("operator arg2", @@ -4544,6 +4727,8 @@ and (do_check : { no_guard = (ctx.no_guard); + unfolding_ok = + (ctx.unfolding_ok); error_context = (("ascription subtyping", FStar_Pervasives_Native.None) @@ -4625,6 +4810,7 @@ and (do_check : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("ascription comp", FStar_Pervasives_Native.None) :: @@ -4638,11 +4824,22 @@ and (do_check : let uu___10 = let uu___11 = let c_e = as_comp g (eff, te) in - let uu___12 = - check_relation_comp g - (SUBTYPING - (FStar_Pervasives_Native.Some e2)) - c_e c in + let uu___12 ctx = + let ctx1 = + { + no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); + error_context = + (("ascription subtyping (comp)", + FStar_Pervasives_Native.None) + :: (ctx.error_context)) + } in + let uu___13 = + check_relation_comp g + (SUBTYPING + (FStar_Pervasives_Native.Some + e2)) c_e c in + uu___13 ctx1 in fun ctx02 -> let uu___13 = uu___12 ctx02 in match uu___13 with @@ -4705,8 +4902,8 @@ and (do_check : (match uu___1 with | (g', x1, body1) -> let uu___2 = - FStar_Ident.lid_equals lb.FStar_Syntax_Syntax.lbeff - FStar_Parser_Const.effect_Tot_lid in + FStar_Syntax_Util.is_pure_or_ghost_effect + lb.FStar_Syntax_Syntax.lbeff in if uu___2 then let uu___3 = @@ -4746,6 +4943,9 @@ and (do_check : no_guard = (ctx.no_guard); + unfolding_ok + = + (ctx.unfolding_ok); error_context = (("let subtyping", @@ -4759,7 +4959,8 @@ and (do_check : g (FStar_Pervasives_Native.Some (lb.FStar_Syntax_Syntax.lbdef)) - tdef ttyp in + tdef + lb.FStar_Syntax_Syntax.lbtyp in uu___17 ctx1 in fun ctx03 -> let uu___17 @@ -4962,6 +5163,7 @@ and (do_check : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("universe_of", (FStar_Pervasives_Native.Some @@ -5044,6 +5246,8 @@ and (do_check : { no_guard = (ctx.no_guard); + unfolding_ok = + (ctx.unfolding_ok); error_context = (("check_pat", FStar_Pervasives_Native.None) @@ -5130,6 +5334,9 @@ and (do_check : no_guard = (ctx.no_guard); + unfolding_ok + = + (ctx.unfolding_ok); error_context = (("branch", @@ -5233,6 +5440,9 @@ and (do_check : no_guard = (ctx.no_guard); + unfolding_ok + = + (ctx.unfolding_ok); error_context = (("check_branch_subtype", @@ -5462,6 +5672,8 @@ and (do_check : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = + (ctx.unfolding_ok); error_context = (("residual type", (FStar_Pervasives_Native.Some @@ -5516,6 +5728,8 @@ and (do_check : { no_guard = (ctx1.no_guard); + unfolding_ok = + (ctx1.unfolding_ok); error_context = (("check_branches", ctx) :: @@ -5598,6 +5812,7 @@ and (do_check : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("universe_of", (FStar_Pervasives_Native.Some @@ -5764,6 +5979,9 @@ and (do_check : no_guard = (ctx.no_guard); + unfolding_ok + = + (ctx.unfolding_ok); error_context = (("check_pat", @@ -5905,11 +6123,31 @@ and (do_check : (FStar_Pervasives_Native.Some b1) in let uu___36 + ctx = + let ctx1 + = + { + no_guard + = + (ctx.no_guard); + unfolding_ok + = + (ctx.unfolding_ok); + error_context + = + (("branch check relation", + FStar_Pervasives_Native.None) + :: + (ctx.error_context)) + } in + let uu___37 = check_relation g'1 rel tbr expect_tbr in + uu___37 + ctx1 in (fun ctx07 -> let uu___37 @@ -6367,6 +6605,7 @@ and (check_comp : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("comp fully applied", FStar_Pervasives_Native.None) :: @@ -6501,10 +6740,22 @@ and (check_pat : let uu___3 = match x with | (uu___4, t_const) -> - let uu___5 = - let uu___6 = unrefine_tsc t_sc in - check_subtype g (FStar_Pervasives_Native.Some e) - t_const uu___6 in + let uu___5 ctx = + let ctx1 = + { + no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); + error_context = + (("check_pat constant", + FStar_Pervasives_Native.None) :: + (ctx.error_context)) + } in + let uu___6 = + let uu___7 = unrefine_tsc t_sc in + check_subtype g + (FStar_Pervasives_Native.Some e) t_const + uu___7 in + uu___6 ctx1 in (fun ctx01 -> let uu___6 = uu___5 ctx01 in match uu___6 with @@ -6544,6 +6795,7 @@ and (check_pat : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("check_pat_binder", FStar_Pervasives_Native.None) :: (ctx.error_context)) @@ -6654,26 +6906,49 @@ and (check_pat : match x1 with | (uu___16, p_t) -> - (fun ctx02 - -> - let uu___17 + let uu___17 + ctx = + let ctx1 + = + { + no_guard + = + (ctx.no_guard); + unfolding_ok + = + (ctx.unfolding_ok); + error_context + = + (("check_pat cons", + FStar_Pervasives_Native.None) + :: + (ctx.error_context)) + } in + let uu___18 = check_subtype g (FStar_Pervasives_Native.Some x) p_t - expected_t + expected_t in + uu___18 + ctx1 in + (fun ctx02 + -> + let uu___18 + = + uu___17 ctx02 in - match uu___17 + match uu___18 with | Success (x2, g12) -> - let uu___18 - = let uu___19 - uu___20 = + = + let uu___20 + uu___21 = Success ((FStar_List_Tot_Base.op_At ss @@ -6681,24 +6956,24 @@ and (check_pat : FStar_Syntax_Syntax.NT (f, x)]), FStar_Pervasives_Native.None) in - uu___19 + uu___20 ctx02 in - (match uu___18 + (match uu___19 with | Success (y, g2) -> - let uu___19 - = let uu___20 = + let uu___21 + = and_pre g12 g2 in (y, - uu___20) in + uu___21) in Success - uu___19 + uu___20 | err -> err) @@ -7429,6 +7704,7 @@ let (check_term_top : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("top-level subtyping", FStar_Pervasives_Native.None) :: @@ -7533,6 +7809,7 @@ let (check_term_top_gh : (let ctx = { no_guard = false; + unfolding_ok = true; error_context = [("Top", FStar_Pervasives_Native.None)] } in let res = @@ -7729,80 +8006,101 @@ let (open_binders_in_comp : let uu___ = open_comp_binders g bs c in match uu___ with | (g', bs1, c1) -> ((g'.tcenv), bs1, c1) let (check_term_equality : - FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.typ -> - FStar_Syntax_Syntax.typ -> - (FStar_Syntax_Syntax.typ FStar_Pervasives_Native.option, error) - FStar_Pervasives.either) + Prims.bool -> + Prims.bool -> + FStar_TypeChecker_Env.env -> + FStar_Syntax_Syntax.typ -> + FStar_Syntax_Syntax.typ -> + (FStar_Syntax_Syntax.typ FStar_Pervasives_Native.option, + error) FStar_Pervasives.either) = - fun g -> - fun t0 -> - fun t1 -> - let g1 = initial_env g FStar_Pervasives_Native.None in - (let uu___1 = - FStar_TypeChecker_Env.debug g1.tcenv - (FStar_Options.Other "CoreTop") in - if uu___1 - then - let uu___2 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term t0 in - let uu___3 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term t1 in - FStar_Compiler_Util.print2 - "Entering check_term_equality with %s and %s {\n" uu___2 uu___3 - else ()); - (let ctx = - { - no_guard = false; - error_context = [("Eq", FStar_Pervasives_Native.None)] - } in - let r = let uu___1 = check_relation g1 EQUALITY t0 t1 in uu___1 ctx in - (let uu___2 = - FStar_TypeChecker_Env.debug g1.tcenv - (FStar_Options.Other "CoreTop") in - if uu___2 - then - let uu___3 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term t0 in - let uu___4 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term t1 in - let uu___5 = - FStar_Class_Show.show - (showable_result - (FStar_Class_Show.show_tuple2 - (FStar_Class_Show.printableshow - FStar_Class_Printable.printable_unit) - (FStar_Class_Show.show_option - FStar_Syntax_Print.showable_term))) r in - FStar_Compiler_Util.print3 - "} Exiting check_term_equality (%s, %s). Result = %s.\n" uu___3 - uu___4 uu___5 - else ()); - (let r1 = - match r with - | Success (uu___2, g2) -> FStar_Pervasives.Inl g2 - | Error err -> FStar_Pervasives.Inr err in - r1)) + fun guard_ok -> + fun unfolding_ok1 -> + fun g -> + fun t0 -> + fun t1 -> + let g1 = initial_env g FStar_Pervasives_Native.None in + (let uu___1 = + FStar_TypeChecker_Env.debug g1.tcenv + (FStar_Options.Other "CoreTop") in + if uu___1 + then + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t0 in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t1 in + let uu___4 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) guard_ok in + let uu___5 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) unfolding_ok1 in + FStar_Compiler_Util.print4 + "Entering check_term_equality with %s and %s (guard_ok=%s; unfolding_ok=%s) {\n" + uu___2 uu___3 uu___4 uu___5 + else ()); + (let ctx = + { + no_guard = (Prims.op_Negation guard_ok); + unfolding_ok = unfolding_ok1; + error_context = [("Eq", FStar_Pervasives_Native.None)] + } in + let r = + let uu___1 = check_relation g1 EQUALITY t0 t1 in uu___1 ctx in + (let uu___2 = + FStar_TypeChecker_Env.debug g1.tcenv + (FStar_Options.Other "CoreTop") in + if uu___2 + then + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t0 in + let uu___4 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t1 in + let uu___5 = + FStar_Class_Show.show + (showable_result + (FStar_Class_Show.show_tuple2 + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_unit) + (FStar_Class_Show.show_option + FStar_Syntax_Print.showable_term))) r in + FStar_Compiler_Util.print3 + "} Exiting check_term_equality (%s, %s). Result = %s.\n" + uu___3 uu___4 uu___5 + else ()); + (let r1 = + match r with + | Success (uu___2, g2) -> FStar_Pervasives.Inl g2 + | Error err -> FStar_Pervasives.Inr err in + r1)) let (check_term_subtyping : - FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.typ -> - FStar_Syntax_Syntax.typ -> - (FStar_Syntax_Syntax.typ FStar_Pervasives_Native.option, error) - FStar_Pervasives.either) + Prims.bool -> + Prims.bool -> + FStar_TypeChecker_Env.env -> + FStar_Syntax_Syntax.typ -> + FStar_Syntax_Syntax.typ -> + (FStar_Syntax_Syntax.typ FStar_Pervasives_Native.option, + error) FStar_Pervasives.either) = - fun g -> - fun t0 -> - fun t1 -> - let g1 = initial_env g FStar_Pervasives_Native.None in - let ctx = - { - no_guard = false; - error_context = [("Subtyping", FStar_Pervasives_Native.None)] - } in - let uu___ = - let uu___1 = - check_relation g1 (SUBTYPING FStar_Pervasives_Native.None) t0 t1 in - uu___1 ctx in - match uu___ with - | Success (uu___1, g2) -> FStar_Pervasives.Inl g2 - | Error err -> FStar_Pervasives.Inr err \ No newline at end of file + fun guard_ok -> + fun unfolding_ok1 -> + fun g -> + fun t0 -> + fun t1 -> + let g1 = initial_env g FStar_Pervasives_Native.None in + let ctx = + { + no_guard = (Prims.op_Negation guard_ok); + unfolding_ok = unfolding_ok1; + error_context = [("Subtyping", FStar_Pervasives_Native.None)] + } in + let uu___ = + let uu___1 = + check_relation g1 (SUBTYPING FStar_Pervasives_Native.None) t0 + t1 in + uu___1 ctx in + match uu___ with + | Success (uu___1, g2) -> FStar_Pervasives.Inl g2 + | Error err -> FStar_Pervasives.Inr err \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Base.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Base.ml index d1342807be4..bb035047116 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Base.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Base.ml @@ -1981,4 +1981,303 @@ let mk5' : "arity")) in as_primitive_step_nbecbs true (name, (Prims.of_int (5)), u_arity, - interp, nbe_interp) \ No newline at end of file + interp, nbe_interp) +let mk6' : + 'a 'b 'c 'd 'e 'f 'r 'na 'nb 'nc 'nd 'ne 'nf 'nr . + Prims.int -> + FStar_Ident.lid -> + 'a FStar_Syntax_Embeddings_Base.embedding -> + 'na FStar_TypeChecker_NBETerm.embedding -> + 'b FStar_Syntax_Embeddings_Base.embedding -> + 'nb FStar_TypeChecker_NBETerm.embedding -> + 'c FStar_Syntax_Embeddings_Base.embedding -> + 'nc FStar_TypeChecker_NBETerm.embedding -> + 'd FStar_Syntax_Embeddings_Base.embedding -> + 'nd FStar_TypeChecker_NBETerm.embedding -> + 'e FStar_Syntax_Embeddings_Base.embedding -> + 'ne FStar_TypeChecker_NBETerm.embedding -> + 'f FStar_Syntax_Embeddings_Base.embedding -> + 'nf FStar_TypeChecker_NBETerm.embedding -> + 'r FStar_Syntax_Embeddings_Base.embedding -> + 'nr FStar_TypeChecker_NBETerm.embedding -> + ('a -> + 'b -> + 'c -> + 'd -> + 'e -> + 'f -> + 'r + FStar_Pervasives_Native.option) + -> + ('na -> + 'nb -> + 'nc -> + 'nd -> + 'ne -> + 'nf -> + 'nr + FStar_Pervasives_Native.option) + -> primitive_step + = + fun u_arity -> + fun name -> + fun uu___ -> + fun uu___1 -> + fun uu___2 -> + fun uu___3 -> + fun uu___4 -> + fun uu___5 -> + fun uu___6 -> + fun uu___7 -> + fun uu___8 -> + fun uu___9 -> + fun uu___10 -> + fun uu___11 -> + fun uu___12 -> + fun uu___13 -> + fun ff -> + fun nbe_ff -> + let interp psc1 cb us args = + match args with + | (a1, uu___14)::(b1, uu___15):: + (c1, uu___16)::(d1, uu___17):: + (e1, uu___18)::(f1, uu___19)::[] + -> + Obj.magic + (Obj.repr + (let uu___20 = + let uu___21 = + let uu___22 = + let uu___23 = + let uu___24 = + let uu___25 = + let uu___26 = + try_unembed_simple + uu___ a1 in + Obj.magic + (FStar_Class_Monad.op_Less_Dollar_Greater + FStar_Class_Monad.monad_option + () () + (fun + uu___27 + -> + (Obj.magic + ff) + uu___27) + (Obj.magic + uu___26)) in + let uu___26 = + try_unembed_simple + uu___2 b1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic + uu___25) + (Obj.magic + uu___26)) in + let uu___25 = + try_unembed_simple + uu___4 c1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic + uu___24) + (Obj.magic + uu___25)) in + let uu___24 = + try_unembed_simple + uu___6 d1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic + uu___23) + (Obj.magic + uu___24)) in + let uu___23 = + try_unembed_simple + uu___8 e1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic uu___22) + (Obj.magic uu___23)) in + let uu___22 = + try_unembed_simple + uu___10 f1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic uu___21) + (Obj.magic uu___22)) in + FStar_Class_Monad.op_let_Bang + FStar_Class_Monad.monad_option + () () (Obj.magic uu___20) + (fun uu___21 -> + (fun r1 -> + let r1 = + Obj.magic r1 in + Obj.magic + (FStar_Class_Monad.op_let_Bang + FStar_Class_Monad.monad_option + () () + (Obj.magic r1) + (fun uu___21 + -> + (fun r2 -> + let r2 = + Obj.magic + r2 in + let uu___21 + = + embed_simple + uu___12 + psc1.psc_range + r2 in + Obj.magic + (FStar_Class_Monad.return + FStar_Class_Monad.monad_option + () + (Obj.magic + uu___21))) + uu___21))) + uu___21))) + | uu___14 -> + Obj.magic + (Obj.repr + (FStar_Compiler_Effect.failwith + "arity")) in + let nbe_interp cbs us args = + match args with + | (a1, uu___14)::(b1, uu___15):: + (c1, uu___16)::(d1, uu___17):: + (e1, uu___18)::(f1, uu___19)::[] + -> + Obj.magic + (Obj.repr + (let uu___20 = + let uu___21 = + let uu___22 = + let uu___23 = + let uu___24 = + let uu___25 = + let uu___26 = + FStar_TypeChecker_NBETerm.unembed + (solve + uu___1) + cbs a1 in + Obj.magic + (FStar_Class_Monad.op_Less_Dollar_Greater + FStar_Class_Monad.monad_option + () () + (fun + uu___27 + -> + (Obj.magic + nbe_ff) + uu___27) + (Obj.magic + uu___26)) in + let uu___26 = + FStar_TypeChecker_NBETerm.unembed + (solve uu___3) + cbs b1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic + uu___25) + (Obj.magic + uu___26)) in + let uu___25 = + FStar_TypeChecker_NBETerm.unembed + (solve uu___5) + cbs c1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic + uu___24) + (Obj.magic + uu___25)) in + let uu___24 = + FStar_TypeChecker_NBETerm.unembed + (solve uu___7) + cbs d1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic + uu___23) + (Obj.magic + uu___24)) in + let uu___23 = + FStar_TypeChecker_NBETerm.unembed + (solve uu___9) cbs + e1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic uu___22) + (Obj.magic uu___23)) in + let uu___22 = + FStar_TypeChecker_NBETerm.unembed + (solve uu___11) cbs + f1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic uu___21) + (Obj.magic uu___22)) in + FStar_Class_Monad.op_let_Bang + FStar_Class_Monad.monad_option + () () (Obj.magic uu___20) + (fun uu___21 -> + (fun r1 -> + let r1 = + Obj.magic r1 in + Obj.magic + (FStar_Class_Monad.op_let_Bang + FStar_Class_Monad.monad_option + () () + (Obj.magic r1) + (fun uu___21 + -> + (fun r2 -> + let r2 = + Obj.magic + r2 in + let uu___21 + = + FStar_TypeChecker_NBETerm.embed + (solve + uu___13) + cbs r2 in + Obj.magic + (FStar_Class_Monad.return + FStar_Class_Monad.monad_option + () + (Obj.magic + uu___21))) + uu___21))) + uu___21))) + | uu___14 -> + Obj.magic + (Obj.repr + (FStar_Compiler_Effect.failwith + "arity")) in + as_primitive_step_nbecbs true + (name, (Prims.of_int (6)), u_arity, + interp, nbe_interp) \ No newline at end of file diff --git a/ocaml/fstar-tests/generated/FStar_Tests_Unif.ml b/ocaml/fstar-tests/generated/FStar_Tests_Unif.ml index 64fefa85358..5ea2b133be9 100644 --- a/ocaml/fstar-tests/generated/FStar_Tests_Unif.ml +++ b/ocaml/fstar-tests/generated/FStar_Tests_Unif.ml @@ -155,8 +155,11 @@ let (check_core : (let env = tcenv () in let res = if subtyping - then FStar_TypeChecker_Core.check_term_subtyping env x y - else FStar_TypeChecker_Core.check_term_equality env x y in + then + FStar_TypeChecker_Core.check_term_subtyping true true env x + y + else + FStar_TypeChecker_Core.check_term_equality true true env x y in (match res with | FStar_Pervasives.Inl (FStar_Pervasives_Native.None) -> let uu___2 = FStar_Compiler_Util.string_of_int i in From 5c011d5c5fef1fee29f5fbcd85152f24801dddeb Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Fri, 19 Apr 2024 10:28:49 -0700 Subject: [PATCH 032/239] current check is not strict enough; can still break it using injectivity of _data_ constructor on the type parameter --- tests/bug-reports/BugBoxInjectivity.fst | 160 +++++++++++++++--------- 1 file changed, 101 insertions(+), 59 deletions(-) diff --git a/tests/bug-reports/BugBoxInjectivity.fst b/tests/bug-reports/BugBoxInjectivity.fst index 67a21c24591..740d264677a 100644 --- a/tests/bug-reports/BugBoxInjectivity.fst +++ b/tests/bug-reports/BugBoxInjectivity.fst @@ -1,62 +1,104 @@ module BugBoxInjectivity -#restart-solver -#push-options "--log_queries --query_stats --debug BugBoxInjectivity --debug_level SMTEncoding" -module CC = FStar.Cardinality.Universes -noeq -type test (a:Type u#0 -> Type u#1) : Type u#1 = - | Mk : test a - -let const (f:Type u#1) : Type u#0 -> Type u#1 = fun _ -> f -let itest (f:Type u#1) : Type u#1 = test (const f) -let itest_inhabited (f:Type u#1) : itest f = Mk -let const_inversion (f0 f1:Type u#1) -: Lemma - (requires const f0 == const f1) - (ensures f0 == f1) -= let _f0 = const f0 int in - let _f1 = const f1 int in - assert (_f0 == _f1); - () -let itest_injective (f0 f1:Type u#1) -: Lemma - (ensures itest f0 == itest f1 ==> const f0 == const f1) -= let x : test (const f0) = itest_inhabited f0 in - let Mk #_ = x in - () open FStar.Functions -let itest_injective' : squash (is_inj itest) = - introduce forall f0 f1. - itest f0 == itest f1 ==> f0 == f1 - with introduce _ ==> _ - with _ . ( - itest_injective f0 f1; - const_inversion f0 f1 - ) -[@@expect_failure [189]] //itest is not in the right universe to use this lemma -let fals : squash False = - CC.no_inj_universes_suc itest - - -#push-options "--ext 'compat:injectivity'" -noeq -type test2 (a:Type u#2) : Type u#1 = - | Mk2 : test2 a -#pop-options - -let test2_inhabited (f:Type u#2) : test2 f = Mk2 -let test2_injective (f0 f1:Type u#2) +module CC = FStar.Cardinality.Universes + +type t (a:Type u#1) : Type u#0 = + | Mk : t a + +//We can get the problematic axiom by +//relying on an equation introduced by the pattern +//match and give it to SMT +let inj_t (#a:Type u#1) (x:t a) +: Lemma (x == Mk #a) + [SMTPat (has_type x (t a))] += let Mk #_ = x in () + +#push-options "--log_queries" +#restart-solver +let t_injective_alt (f0 f1:Type u#1) (x: t f0) (y:t f1) : Lemma - (ensures test2 f0 == test2 f1 ==> f0 == f1) -= let x : test2 f0 = test2_inhabited f0 in - let Mk2 #_ = x in - () -open FStar.Functions -let itest2_injective' : squash (is_inj test2) = - introduce forall f0 f1. - test2 f0 == test2 f1 ==> f0 == f1 - with introduce _ ==> _ - with _ . ( - test2_injective f0 f1 - ) -let fals () : squash False = - CC.no_inj_universes_suc test2 \ No newline at end of file + (ensures t f0 == t f1 ==> f0 == f1) += () + +// let t_injective (f0 f1:Type u#1) +// : Lemma +// (ensures t f0 == t f1 ==> f0 == f1) +// = t_injective_alt f0 f1 Mk Mk + +// let t_injective' : squash (is_inj t) = +// introduce forall f0 f1. +// t f0 == t f1 ==> f0 == f1 +// with introduce _ ==> _ +// with _ . ( +// t_injective f0 f1 +// ) +// let fals : squash False = +// CC.no_inj_universes_suc t + +// /////////////////// +// let test (#a:Type) (x:t a) = +// match x with +// | Mkt #_ f -> +// assert (x == Mkt #a f) + +// #restart-solver +// #push-options "--log_queries --query_stats --debug BugBoxInjectivity --debug_level SMTEncoding" +// module CC = FStar.Cardinality.Universes +// noeq +// type test (a:Type u#0 -> Type u#1) : Type u#1 = +// | Mk : test a + +// let const (f:Type u#1) : Type u#0 -> Type u#1 = fun _ -> f +// let itest (f:Type u#1) : Type u#1 = test (const f) +// let itest_inhabited (f:Type u#1) : itest f = Mk +// let const_inversion (f0 f1:Type u#1) +// : Lemma +// (requires const f0 == const f1) +// (ensures f0 == f1) +// = let _f0 = const f0 int in +// let _f1 = const f1 int in +// assert (_f0 == _f1); +// () +// let itest_injective (f0 f1:Type u#1) +// : Lemma +// (ensures itest f0 == itest f1 ==> const f0 == const f1) +// = let x : test (const f0) = itest_inhabited f0 in +// let Mk #_ = x in +// () +// open FStar.Functions +// let itest_injective' : squash (is_inj itest) = +// introduce forall f0 f1. +// itest f0 == itest f1 ==> f0 == f1 +// with introduce _ ==> _ +// with _ . ( +// itest_injective f0 f1; +// const_inversion f0 f1 +// ) +// [@@expect_failure [189]] //itest is not in the right universe to use this lemma +// let fals : squash False = +// CC.no_inj_universes_suc itest + + +// #push-options "--ext 'compat:injectivity'" +// noeq +// type test2 (a:Type u#2) : Type u#1 = +// | Mk2 : test2 a +// #pop-options + +// let test2_inhabited (f:Type u#2) : test2 f = Mk2 +// let test2_injective (f0 f1:Type u#2) +// : Lemma +// (ensures test2 f0 == test2 f1 ==> f0 == f1) +// = let x : test2 f0 = test2_inhabited f0 in +// let Mk2 #_ = x in +// () +// open FStar.Functions +// let itest2_injective' : squash (is_inj test2) = +// introduce forall f0 f1. +// test2 f0 == test2 f1 ==> f0 == f1 +// with introduce _ ==> _ +// with _ . ( +// test2_injective f0 f1 +// ) +// let fals () : squash False = +// CC.no_inj_universes_suc test2 \ No newline at end of file From 35380d320ca9719564145e5e1f9d3269e26d372f Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Fri, 19 Apr 2024 10:29:18 -0700 Subject: [PATCH 033/239] refactoring encoding of inductive type and datacon to prepare for a revised check --- .../generated/FStar_SMTEncoding_Encode.ml | 3829 +++++++++-------- src/smtencoding/FStar.SMTEncoding.Encode.fst | 1136 ++--- 2 files changed, 2542 insertions(+), 2423 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index dbfe7f06e7b..5fa3195d52e 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -3761,1275 +3761,567 @@ let (encode_top_level_let : (Prims.strcat "let rec unencodeable: Skipping: " msg) in let uu___2 = FStar_SMTEncoding_Term.mk_decls_trivial [decl] in (uu___2, env)) -let rec (encode_sigelt : - FStar_SMTEncoding_Env.env_t -> - FStar_Syntax_Syntax.sigelt -> - (FStar_SMTEncoding_Term.decls_t * FStar_SMTEncoding_Env.env_t)) - = +let (is_sig_inductive_injective_on_params : + FStar_SMTEncoding_Env.env_t -> FStar_Syntax_Syntax.sigelt -> Prims.bool) = fun env -> fun se -> - let nm = FStar_Syntax_Print.sigelt_to_string_short se in - let uu___ = - let uu___1 = - let uu___2 = FStar_Syntax_Print.sigelt_to_string_short se in - FStar_Compiler_Util.format1 - "While encoding top-level declaration `%s`" uu___2 in - FStar_Errors.with_ctx uu___1 (fun uu___2 -> encode_sigelt' env se) in + let uu___ = se.FStar_Syntax_Syntax.sigel in match uu___ with - | (g, env1) -> - let g1 = - match g with - | [] -> - ((let uu___2 = - FStar_TypeChecker_Env.debug - env1.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in - if uu___2 - then - FStar_Compiler_Util.print1 "Skipped encoding of %s\n" nm - else ()); - (let uu___2 = - let uu___3 = - let uu___4 = - FStar_Compiler_Util.format1 "" nm in - FStar_SMTEncoding_Term.Caption uu___4 in - [uu___3] in - FStar_SMTEncoding_Term.mk_decls_trivial uu___2)) - | uu___1 -> - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - FStar_Compiler_Util.format1 "" nm in - FStar_SMTEncoding_Term.Caption uu___5 in - [uu___4] in - FStar_SMTEncoding_Term.mk_decls_trivial uu___3 in - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = - FStar_Compiler_Util.format1 "" nm in - FStar_SMTEncoding_Term.Caption uu___7 in - [uu___6] in - FStar_SMTEncoding_Term.mk_decls_trivial uu___5 in - FStar_Compiler_List.op_At g uu___4 in - FStar_Compiler_List.op_At uu___2 uu___3 in - (g1, env1) -and (encode_sigelt' : - FStar_SMTEncoding_Env.env_t -> - FStar_Syntax_Syntax.sigelt -> - (FStar_SMTEncoding_Term.decls_t * FStar_SMTEncoding_Env.env_t)) + | FStar_Syntax_Syntax.Sig_inductive_typ + { FStar_Syntax_Syntax.lid = t; + FStar_Syntax_Syntax.us = universe_names; + FStar_Syntax_Syntax.params = tps; + FStar_Syntax_Syntax.num_uniform_params = uu___1; + FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___2; + FStar_Syntax_Syntax.ds = uu___3;_} + -> + let t_lid = t in + let tcenv = env.FStar_SMTEncoding_Env.tcenv in + let uu___4 = FStar_Syntax_Subst.univ_var_opening universe_names in + (match uu___4 with + | (usubst, uvs) -> + let uu___5 = + let uu___6 = FStar_TypeChecker_Env.push_univ_vars tcenv uvs in + let uu___7 = FStar_Syntax_Subst.subst_binders usubst tps in + let uu___8 = + let uu___9 = + FStar_Syntax_Subst.shift_subst + (FStar_Compiler_List.length tps) usubst in + FStar_Syntax_Subst.subst uu___9 k in + (uu___6, uu___7, uu___8) in + (match uu___5 with + | (tcenv1, tps1, k1) -> + let uu___6 = FStar_Syntax_Subst.open_term tps1 k1 in + (match uu___6 with + | (tps2, k2) -> + let uu___7 = FStar_Syntax_Util.arrow_formals k2 in + (match uu___7 with + | (uu___8, k3) -> + let uu___9 = + FStar_TypeChecker_TcTerm.tc_binders tcenv1 + tps2 in + (match uu___9 with + | (tps3, env_tps, uu___10, us) -> + let u_k = + let uu___11 = + let uu___12 = + FStar_Syntax_Syntax.fvar t + FStar_Pervasives_Native.None in + let uu___13 = + let uu___14 = + FStar_Syntax_Util.args_of_binders + tps3 in + FStar_Pervasives_Native.snd uu___14 in + let uu___14 = + FStar_Ident.range_of_lid t in + FStar_Syntax_Syntax.mk_Tm_app uu___12 + uu___13 uu___14 in + FStar_TypeChecker_TcTerm.level_of_type + env_tps uu___11 k3 in + let rec universe_leq u v = + match (u, v) with + | (FStar_Syntax_Syntax.U_zero, uu___11) + -> true + | (FStar_Syntax_Syntax.U_succ u0, + FStar_Syntax_Syntax.U_succ v0) -> + universe_leq u0 v0 + | (FStar_Syntax_Syntax.U_name u0, + FStar_Syntax_Syntax.U_name v0) -> + FStar_Ident.ident_equals u0 v0 + | (FStar_Syntax_Syntax.U_name uu___11, + FStar_Syntax_Syntax.U_succ v0) -> + universe_leq u v0 + | (FStar_Syntax_Syntax.U_max us1, + uu___11) -> + FStar_Compiler_Util.for_all + (fun u1 -> universe_leq u1 v) us1 + | (uu___11, FStar_Syntax_Syntax.U_max + vs) -> + FStar_Compiler_Util.for_some + (universe_leq u) vs + | (FStar_Syntax_Syntax.U_unknown, + uu___11) -> + let uu___12 = + let uu___13 = + FStar_Ident.string_of_lid t in + let uu___14 = + FStar_Syntax_Print.univ_to_string + u in + let uu___15 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___13 uu___14 uu___15 in + FStar_Compiler_Effect.failwith + uu___12 + | (uu___11, + FStar_Syntax_Syntax.U_unknown) -> + let uu___12 = + let uu___13 = + FStar_Ident.string_of_lid t in + let uu___14 = + FStar_Syntax_Print.univ_to_string + u in + let uu___15 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___13 uu___14 uu___15 in + FStar_Compiler_Effect.failwith + uu___12 + | (FStar_Syntax_Syntax.U_unif uu___11, + uu___12) -> + let uu___13 = + let uu___14 = + FStar_Ident.string_of_lid t in + let uu___15 = + FStar_Syntax_Print.univ_to_string + u in + let uu___16 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___14 uu___15 uu___16 in + FStar_Compiler_Effect.failwith + uu___13 + | (uu___11, FStar_Syntax_Syntax.U_unif + uu___12) -> + let uu___13 = + let uu___14 = + FStar_Ident.string_of_lid t in + let uu___15 = + FStar_Syntax_Print.univ_to_string + u in + let uu___16 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___14 uu___15 uu___16 in + FStar_Compiler_Effect.failwith + uu___13 + | uu___11 -> false in + let u_leq_u_k u = + let u1 = + FStar_TypeChecker_Normalize.normalize_universe + env_tps u in + universe_leq u1 u_k in + let tp_ok tp u_tp = + let t_tp = + (tp.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in + let uu___11 = u_leq_u_k u_tp in + if uu___11 + then true + else + (let t_tp1 = + FStar_TypeChecker_Normalize.normalize + [FStar_TypeChecker_Env.Unrefine; + FStar_TypeChecker_Env.Unascribe; + FStar_TypeChecker_Env.Unmeta; + FStar_TypeChecker_Env.Primops; + FStar_TypeChecker_Env.HNF; + FStar_TypeChecker_Env.UnfoldUntil + FStar_Syntax_Syntax.delta_constant; + FStar_TypeChecker_Env.Beta] + env_tps t_tp in + let uu___13 = + FStar_Syntax_Util.arrow_formals + t_tp1 in + match uu___13 with + | (formals, t1) -> + let uu___14 = + FStar_TypeChecker_TcTerm.tc_binders + env_tps formals in + (match uu___14 with + | (uu___15, uu___16, uu___17, + u_formals) -> + let inj = + FStar_Compiler_Util.for_all + (fun u_formal -> + u_leq_u_k u_formal) + u_formals in + if inj + then + let uu___18 = + let uu___19 = + FStar_Syntax_Subst.compress + t1 in + uu___19.FStar_Syntax_Syntax.n in + (match uu___18 with + | FStar_Syntax_Syntax.Tm_type + u -> u_leq_u_k u + | uu___19 -> false) + else false)) in + let is_injective_on_params = + FStar_Compiler_List.forall2 tp_ok tps3 + us in + ((let uu___12 = + FStar_TypeChecker_Env.debug + env.FStar_SMTEncoding_Env.tcenv + (FStar_Options.Other "SMTEncoding") in + if uu___12 + then + let uu___13 = + FStar_Ident.string_of_lid t in + FStar_Compiler_Util.print2 + "%s injectivity for %s\n" + (if is_injective_on_params + then "YES" + else "NO") uu___13 + else ()); + is_injective_on_params)))))) +let (encode_sig_inductive : + Prims.bool -> + FStar_SMTEncoding_Env.env_t -> + FStar_Syntax_Syntax.sigelt -> + (FStar_SMTEncoding_Term.decls_t * FStar_SMTEncoding_Env.env_t)) = - fun env -> - fun se -> - (let uu___1 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in - if uu___1 - then - let uu___2 = FStar_Syntax_Print.sigelt_to_string se in - FStar_Compiler_Util.print1 "@@@Encoding sigelt %s\n" uu___2 - else ()); - (let is_opaque_to_smt t = - let uu___1 = - let uu___2 = FStar_Syntax_Subst.compress t in - uu___2.FStar_Syntax_Syntax.n in - match uu___1 with - | FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_string - (s, uu___2)) -> s = "opaque_to_smt" - | uu___2 -> false in - let is_uninterpreted_by_smt t = - let uu___1 = - let uu___2 = FStar_Syntax_Subst.compress t in - uu___2.FStar_Syntax_Syntax.n in - match uu___1 with - | FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_string - (s, uu___2)) -> s = "uninterpreted_by_smt" - | uu___2 -> false in - match se.FStar_Syntax_Syntax.sigel with - | FStar_Syntax_Syntax.Sig_splice uu___1 -> - FStar_Compiler_Effect.failwith - "impossible -- splice should have been removed by Tc.fs" - | FStar_Syntax_Syntax.Sig_fail uu___1 -> - FStar_Compiler_Effect.failwith - "impossible -- Sig_fail should have been removed by Tc.fs" - | FStar_Syntax_Syntax.Sig_pragma uu___1 -> ([], env) - | FStar_Syntax_Syntax.Sig_effect_abbrev uu___1 -> ([], env) - | FStar_Syntax_Syntax.Sig_sub_effect uu___1 -> ([], env) - | FStar_Syntax_Syntax.Sig_polymonadic_bind uu___1 -> ([], env) - | FStar_Syntax_Syntax.Sig_polymonadic_subcomp uu___1 -> ([], env) - | FStar_Syntax_Syntax.Sig_new_effect ed -> - let uu___1 = - let uu___2 = - FStar_SMTEncoding_Util.is_smt_reifiable_effect - env.FStar_SMTEncoding_Env.tcenv ed.FStar_Syntax_Syntax.mname in - Prims.op_Negation uu___2 in - if uu___1 - then ([], env) - else - (let close_effect_params tm = - match ed.FStar_Syntax_Syntax.binders with - | [] -> tm - | uu___3 -> - FStar_Syntax_Syntax.mk - (FStar_Syntax_Syntax.Tm_abs - { - FStar_Syntax_Syntax.bs = - (ed.FStar_Syntax_Syntax.binders); - FStar_Syntax_Syntax.body = tm; - FStar_Syntax_Syntax.rc_opt = - (FStar_Pervasives_Native.Some - (FStar_Syntax_Util.mk_residual_comp - FStar_Parser_Const.effect_Tot_lid - FStar_Pervasives_Native.None - [FStar_Syntax_Syntax.TOTAL])) - }) tm.FStar_Syntax_Syntax.pos in - let encode_action env1 a = - let action_defn = - let uu___3 = - close_effect_params a.FStar_Syntax_Syntax.action_defn in - norm_before_encoding env1 uu___3 in + fun is_injective_on_params -> + fun env -> + fun se -> + let uu___ = se.FStar_Syntax_Syntax.sigel in + match uu___ with + | FStar_Syntax_Syntax.Sig_inductive_typ + { FStar_Syntax_Syntax.lid = t; + FStar_Syntax_Syntax.us = universe_names; + FStar_Syntax_Syntax.params = tps; + FStar_Syntax_Syntax.num_uniform_params = uu___1; + FStar_Syntax_Syntax.t = k; + FStar_Syntax_Syntax.mutuals = uu___2; + FStar_Syntax_Syntax.ds = datas;_} + -> + let t_lid = t in + let tcenv = env.FStar_SMTEncoding_Env.tcenv in + let quals = se.FStar_Syntax_Syntax.sigquals in + let is_logical = + FStar_Compiler_Util.for_some + (fun uu___3 -> + match uu___3 with + | FStar_Syntax_Syntax.Logic -> true + | FStar_Syntax_Syntax.Assumption -> true + | uu___4 -> false) quals in + let constructor_or_logic_type_decl c = + if is_logical + then let uu___3 = - FStar_Syntax_Util.arrow_formals_comp - a.FStar_Syntax_Syntax.action_typ in - match uu___3 with - | (formals, uu___4) -> - let arity = FStar_Compiler_List.length formals in + let uu___4 = let uu___5 = - FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid - env1 a.FStar_Syntax_Syntax.action_name arity in - (match uu___5 with - | (aname, atok, env2) -> - let uu___6 = - FStar_SMTEncoding_EncodeTerm.encode_term - action_defn env2 in - (match uu___6 with - | (tm, decls) -> - let a_decls = - let uu___7 = + FStar_Compiler_List.map + (fun f -> f.FStar_SMTEncoding_Term.field_sort) + c.FStar_SMTEncoding_Term.constr_fields in + ((c.FStar_SMTEncoding_Term.constr_name), uu___5, + FStar_SMTEncoding_Term.Term_sort, + FStar_Pervasives_Native.None) in + FStar_SMTEncoding_Term.DeclFun uu___4 in + [uu___3] + else + (let uu___4 = FStar_Ident.range_of_lid t in + FStar_SMTEncoding_Term.constructor_to_decl uu___4 c) in + let inversion_axioms env1 tapp vars = + let uu___3 = + FStar_Compiler_Util.for_some + (fun l -> + let uu___4 = + FStar_TypeChecker_Env.try_lookup_lid + env1.FStar_SMTEncoding_Env.tcenv l in + FStar_Compiler_Option.isNone uu___4) datas in + if uu___3 + then [] + else + (let uu___5 = + FStar_SMTEncoding_Env.fresh_fvar + env1.FStar_SMTEncoding_Env.current_module_name "x" + FStar_SMTEncoding_Term.Term_sort in + match uu___5 with + | (xxsym, xx) -> + let uu___6 = + FStar_Compiler_List.fold_left + (fun uu___7 -> + fun l -> + match uu___7 with + | (out, decls) -> let uu___8 = - let uu___9 = - FStar_Compiler_List.map - (fun uu___10 -> - FStar_SMTEncoding_Term.Term_sort) - formals in - (aname, uu___9, - FStar_SMTEncoding_Term.Term_sort, - (FStar_Pervasives_Native.Some "Action")) in - FStar_SMTEncoding_Term.DeclFun uu___8 in - [uu___7; - FStar_SMTEncoding_Term.DeclFun - (atok, [], - FStar_SMTEncoding_Term.Term_sort, - (FStar_Pervasives_Native.Some - "Action token"))] in - let uu___7 = - let aux uu___8 uu___9 = - match (uu___8, uu___9) with - | ({ FStar_Syntax_Syntax.binder_bv = bv; - FStar_Syntax_Syntax.binder_qual = - uu___10; - FStar_Syntax_Syntax.binder_positivity - = uu___11; - FStar_Syntax_Syntax.binder_attrs = - uu___12;_}, - (env3, acc_sorts, acc)) -> - let uu___13 = - FStar_SMTEncoding_Env.gen_term_var - env3 bv in - (match uu___13 with - | (xxsym, xx, env4) -> - let uu___14 = - let uu___15 = - FStar_SMTEncoding_Term.mk_fv - (xxsym, - FStar_SMTEncoding_Term.Term_sort) in - uu___15 :: acc_sorts in - (env4, uu___14, (xx :: acc))) in - FStar_Compiler_List.fold_right aux formals - (env2, [], []) in - (match uu___7 with - | (uu___8, xs_sorts, xs) -> - let app = - FStar_SMTEncoding_Util.mkApp (aname, xs) in - let a_eq = - let uu___9 = + FStar_TypeChecker_Env.lookup_datacon + env1.FStar_SMTEncoding_Env.tcenv l in + (match uu___8 with + | (uu___9, data_t) -> let uu___10 = - let uu___11 = - FStar_Ident.range_of_lid - a.FStar_Syntax_Syntax.action_name in - let uu___12 = - let uu___13 = - let uu___14 = - let uu___15 = - FStar_SMTEncoding_EncodeTerm.mk_Apply - tm xs_sorts in - (app, uu___15) in - FStar_SMTEncoding_Util.mkEq - uu___14 in - ([[app]], xs_sorts, uu___13) in - FStar_SMTEncoding_Term.mkForall - uu___11 uu___12 in - (uu___10, - (FStar_Pervasives_Native.Some - "Action equality"), - (Prims.strcat aname "_equality")) in - FStar_SMTEncoding_Util.mkAssume uu___9 in - let tok_correspondence = - let tok_term = - let uu___9 = - FStar_SMTEncoding_Term.mk_fv - (atok, - FStar_SMTEncoding_Term.Term_sort) in - FStar_SMTEncoding_Util.mkFreeV uu___9 in - let tok_app = - FStar_SMTEncoding_EncodeTerm.mk_Apply - tok_term xs_sorts in - let uu___9 = - let uu___10 = - let uu___11 = - FStar_Ident.range_of_lid - a.FStar_Syntax_Syntax.action_name in - let uu___12 = - let uu___13 = - FStar_SMTEncoding_Util.mkEq - (tok_app, app) in - ([[tok_app]], xs_sorts, uu___13) in - FStar_SMTEncoding_Term.mkForall - uu___11 uu___12 in - (uu___10, - (FStar_Pervasives_Native.Some - "Action token correspondence"), - (Prims.strcat aname - "_token_correspondence")) in - FStar_SMTEncoding_Util.mkAssume uu___9 in + FStar_Syntax_Util.arrow_formals + data_t in + (match uu___10 with + | (args, res) -> + let indices = + let uu___11 = + FStar_Syntax_Util.head_and_args_full + res in + FStar_Pervasives_Native.snd + uu___11 in + let env2 = + FStar_Compiler_List.fold_left + (fun env3 -> + fun uu___11 -> + match uu___11 with + | { + FStar_Syntax_Syntax.binder_bv + = x; + FStar_Syntax_Syntax.binder_qual + = uu___12; + FStar_Syntax_Syntax.binder_positivity + = uu___13; + FStar_Syntax_Syntax.binder_attrs + = uu___14;_} + -> + let uu___15 = + let uu___16 = + let uu___17 = + FStar_SMTEncoding_Env.mk_term_projector_name + l x in + (uu___17, [xx]) in + FStar_SMTEncoding_Util.mkApp + uu___16 in + FStar_SMTEncoding_Env.push_term_var + env3 x uu___15) + env1 args in + let uu___11 = + FStar_SMTEncoding_EncodeTerm.encode_args + indices env2 in + (match uu___11 with + | (indices1, decls') -> + (if + (FStar_Compiler_List.length + indices1) + <> + (FStar_Compiler_List.length + vars) + then + FStar_Compiler_Effect.failwith + "Impossible" + else (); + (let eqs = + let uu___13 = + is_injective_on_params + || + (let uu___14 = + FStar_Options.ext_getv + "compat:injectivity" in + uu___14 <> "") in + if uu___13 + then + FStar_Compiler_List.map2 + (fun v -> + fun a -> + let uu___14 = + let uu___15 = + FStar_SMTEncoding_Util.mkFreeV + v in + (uu___15, a) in + FStar_SMTEncoding_Util.mkEq + uu___14) vars + indices1 + else + (let num_params = + FStar_Compiler_List.length + tps in + let uu___15 = + FStar_Compiler_List.splitAt + num_params vars in + match uu___15 with + | (_var_params, + var_indices) -> + let uu___16 = + FStar_Compiler_List.splitAt + num_params + indices1 in + (match uu___16 + with + | (_i_params, + indices2) -> + FStar_Compiler_List.map2 + (fun v -> + fun a -> + let uu___17 + = + let uu___18 + = + FStar_SMTEncoding_Util.mkFreeV + v in + (uu___18, + a) in + FStar_SMTEncoding_Util.mkEq + uu___17) + var_indices + indices2)) in + let uu___13 = + let uu___14 = + let uu___15 = + let uu___16 = + let uu___17 = + FStar_SMTEncoding_Env.mk_data_tester + env2 l xx in + let uu___18 = + FStar_SMTEncoding_Util.mk_and_l + eqs in + (uu___17, uu___18) in + FStar_SMTEncoding_Util.mkAnd + uu___16 in + (out, uu___15) in + FStar_SMTEncoding_Util.mkOr + uu___14 in + (uu___13, + (FStar_Compiler_List.op_At + decls decls')))))))) + (FStar_SMTEncoding_Util.mkFalse, []) datas in + (match uu___6 with + | (data_ax, decls) -> + let uu___7 = + FStar_SMTEncoding_Env.fresh_fvar + env1.FStar_SMTEncoding_Env.current_module_name + "f" FStar_SMTEncoding_Term.Fuel_sort in + (match uu___7 with + | (ffsym, ff) -> + let fuel_guarded_inversion = + let xx_has_type_sfuel = + if + (FStar_Compiler_List.length datas) > + Prims.int_one + then + let uu___8 = + FStar_SMTEncoding_Util.mkApp + ("SFuel", [ff]) in + FStar_SMTEncoding_Term.mk_HasTypeFuel + uu___8 xx tapp + else + FStar_SMTEncoding_Term.mk_HasTypeFuel ff + xx tapp in + let uu___8 = let uu___9 = - let uu___10 = - FStar_SMTEncoding_Term.mk_decls_trivial - (FStar_Compiler_List.op_At a_decls - [a_eq; tok_correspondence]) in - FStar_Compiler_List.op_At decls uu___10 in - (env2, uu___9)))) in - let uu___3 = - FStar_Compiler_Util.fold_map encode_action env - ed.FStar_Syntax_Syntax.actions in - match uu___3 with - | (env1, decls2) -> - ((FStar_Compiler_List.flatten decls2), env1)) - | FStar_Syntax_Syntax.Sig_declare_typ - { FStar_Syntax_Syntax.lid2 = lid; - FStar_Syntax_Syntax.us2 = uu___1; - FStar_Syntax_Syntax.t2 = uu___2;_} - when FStar_Ident.lid_equals lid FStar_Parser_Const.precedes_lid -> - let uu___3 = - FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid env lid - (Prims.of_int (4)) in - (match uu___3 with | (tname, ttok, env1) -> ([], env1)) - | FStar_Syntax_Syntax.Sig_declare_typ - { FStar_Syntax_Syntax.lid2 = lid; - FStar_Syntax_Syntax.us2 = uu___1; FStar_Syntax_Syntax.t2 = t;_} - -> - let quals = se.FStar_Syntax_Syntax.sigquals in - let will_encode_definition = - let uu___2 = - FStar_Compiler_Util.for_some - (fun uu___3 -> - match uu___3 with - | FStar_Syntax_Syntax.Assumption -> true - | FStar_Syntax_Syntax.Projector uu___4 -> true - | FStar_Syntax_Syntax.Discriminator uu___4 -> true - | FStar_Syntax_Syntax.Irreducible -> true - | uu___4 -> false) quals in - Prims.op_Negation uu___2 in - if will_encode_definition - then ([], env) - else - (let fv = - FStar_Syntax_Syntax.lid_as_fv lid - FStar_Pervasives_Native.None in - let uu___3 = - let uu___4 = - FStar_Compiler_Util.for_some is_uninterpreted_by_smt - se.FStar_Syntax_Syntax.sigattrs in - encode_top_level_val uu___4 env fv t quals in - match uu___3 with - | (decls, env1) -> - let tname = FStar_Ident.string_of_lid lid in - let tsym = - let uu___4 = - FStar_SMTEncoding_Env.try_lookup_free_var env1 lid in - FStar_Compiler_Option.get uu___4 in - let uu___4 = + let uu___10 = FStar_Ident.range_of_lid t in + let uu___11 = + let uu___12 = + let uu___13 = + FStar_SMTEncoding_Term.mk_fv + (ffsym, + FStar_SMTEncoding_Term.Fuel_sort) in + let uu___14 = + let uu___15 = + FStar_SMTEncoding_Term.mk_fv + (xxsym, + FStar_SMTEncoding_Term.Term_sort) in + uu___15 :: vars in + FStar_SMTEncoding_Env.add_fuel + uu___13 uu___14 in + let uu___13 = + FStar_SMTEncoding_Util.mkImp + (xx_has_type_sfuel, data_ax) in + ([[xx_has_type_sfuel]], uu___12, + uu___13) in + FStar_SMTEncoding_Term.mkForall uu___10 + uu___11 in + let uu___10 = + let uu___11 = + let uu___12 = + FStar_Ident.string_of_lid t in + Prims.strcat "fuel_guarded_inversion_" + uu___12 in + FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.mk_unique + uu___11 in + (uu___9, + (FStar_Pervasives_Native.Some + "inversion axiom"), uu___10) in + FStar_SMTEncoding_Util.mkAssume uu___8 in + let uu___8 = + FStar_SMTEncoding_Term.mk_decls_trivial + [fuel_guarded_inversion] in + FStar_Compiler_List.op_At decls uu___8))) in + let uu___3 = + let k1 = + match tps with + | [] -> k + | uu___4 -> let uu___5 = let uu___6 = - primitive_type_axioms - env1.FStar_SMTEncoding_Env.tcenv lid tname tsym in - FStar_SMTEncoding_Term.mk_decls_trivial uu___6 in - FStar_Compiler_List.op_At decls uu___5 in - (uu___4, env1)) - | FStar_Syntax_Syntax.Sig_assume - { FStar_Syntax_Syntax.lid3 = l; FStar_Syntax_Syntax.us3 = us; - FStar_Syntax_Syntax.phi1 = f;_} - -> - let uu___1 = FStar_Syntax_Subst.open_univ_vars us f in - (match uu___1 with - | (uvs, f1) -> - let env1 = - let uu___2 = - FStar_TypeChecker_Env.push_univ_vars - env.FStar_SMTEncoding_Env.tcenv uvs in - { - FStar_SMTEncoding_Env.bvar_bindings = - (env.FStar_SMTEncoding_Env.bvar_bindings); - FStar_SMTEncoding_Env.fvar_bindings = - (env.FStar_SMTEncoding_Env.fvar_bindings); - FStar_SMTEncoding_Env.depth = - (env.FStar_SMTEncoding_Env.depth); - FStar_SMTEncoding_Env.tcenv = uu___2; - FStar_SMTEncoding_Env.warn = - (env.FStar_SMTEncoding_Env.warn); - FStar_SMTEncoding_Env.nolabels = - (env.FStar_SMTEncoding_Env.nolabels); - FStar_SMTEncoding_Env.use_zfuel_name = - (env.FStar_SMTEncoding_Env.use_zfuel_name); - FStar_SMTEncoding_Env.encode_non_total_function_typ = - (env.FStar_SMTEncoding_Env.encode_non_total_function_typ); - FStar_SMTEncoding_Env.current_module_name = - (env.FStar_SMTEncoding_Env.current_module_name); - FStar_SMTEncoding_Env.encoding_quantifier = - (env.FStar_SMTEncoding_Env.encoding_quantifier); - FStar_SMTEncoding_Env.global_cache = - (env.FStar_SMTEncoding_Env.global_cache) - } in - let f2 = norm_before_encoding env1 f1 in - let uu___2 = - FStar_SMTEncoding_EncodeTerm.encode_formula f2 env1 in - (match uu___2 with - | (f3, decls) -> - let g = - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = - let uu___8 = - FStar_Syntax_Print.lid_to_string l in - FStar_Compiler_Util.format1 "Assumption: %s" - uu___8 in - FStar_Pervasives_Native.Some uu___7 in - let uu___7 = - let uu___8 = - let uu___9 = FStar_Ident.string_of_lid l in - Prims.strcat "assumption_" uu___9 in - FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.mk_unique - uu___8 in - (f3, uu___6, uu___7) in - FStar_SMTEncoding_Util.mkAssume uu___5 in - [uu___4] in - FStar_SMTEncoding_Term.mk_decls_trivial uu___3 in - ((FStar_Compiler_List.op_At decls g), env1))) - | FStar_Syntax_Syntax.Sig_let - { FStar_Syntax_Syntax.lbs1 = lbs; - FStar_Syntax_Syntax.lids1 = uu___1;_} - when - (FStar_Compiler_List.contains FStar_Syntax_Syntax.Irreducible - se.FStar_Syntax_Syntax.sigquals) - || - (FStar_Compiler_Util.for_some is_opaque_to_smt - se.FStar_Syntax_Syntax.sigattrs) - -> - let attrs = se.FStar_Syntax_Syntax.sigattrs in - let uu___2 = - FStar_Compiler_Util.fold_map - (fun env1 -> - fun lb -> - let lid = - let uu___3 = - let uu___4 = - FStar_Compiler_Util.right - lb.FStar_Syntax_Syntax.lbname in - uu___4.FStar_Syntax_Syntax.fv_name in - uu___3.FStar_Syntax_Syntax.v in - let uu___3 = - let uu___4 = - FStar_TypeChecker_Env.try_lookup_val_decl - env1.FStar_SMTEncoding_Env.tcenv lid in - FStar_Compiler_Option.isNone uu___4 in - if uu___3 - then - let val_decl = + let uu___7 = FStar_Syntax_Syntax.mk_Total k in { - FStar_Syntax_Syntax.sigel = - (FStar_Syntax_Syntax.Sig_declare_typ - { - FStar_Syntax_Syntax.lid2 = lid; - FStar_Syntax_Syntax.us2 = - (lb.FStar_Syntax_Syntax.lbunivs); - FStar_Syntax_Syntax.t2 = - (lb.FStar_Syntax_Syntax.lbtyp) - }); - FStar_Syntax_Syntax.sigrng = - (se.FStar_Syntax_Syntax.sigrng); - FStar_Syntax_Syntax.sigquals = - (FStar_Syntax_Syntax.Irreducible :: - (se.FStar_Syntax_Syntax.sigquals)); - FStar_Syntax_Syntax.sigmeta = - (se.FStar_Syntax_Syntax.sigmeta); - FStar_Syntax_Syntax.sigattrs = - (se.FStar_Syntax_Syntax.sigattrs); - FStar_Syntax_Syntax.sigopens_and_abbrevs = - (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); - FStar_Syntax_Syntax.sigopts = - (se.FStar_Syntax_Syntax.sigopts) + FStar_Syntax_Syntax.bs1 = tps; + FStar_Syntax_Syntax.comp = uu___7 } in - let uu___4 = encode_sigelt' env1 val_decl in - match uu___4 with | (decls, env2) -> (env2, decls) - else (env1, [])) env (FStar_Pervasives_Native.snd lbs) in - (match uu___2 with - | (env1, decls) -> ((FStar_Compiler_List.flatten decls), env1)) - | FStar_Syntax_Syntax.Sig_let - { - FStar_Syntax_Syntax.lbs1 = - (uu___1, - { FStar_Syntax_Syntax.lbname = FStar_Pervasives.Inr b2t; - FStar_Syntax_Syntax.lbunivs = uu___2; - FStar_Syntax_Syntax.lbtyp = uu___3; - FStar_Syntax_Syntax.lbeff = uu___4; - FStar_Syntax_Syntax.lbdef = uu___5; - FStar_Syntax_Syntax.lbattrs = uu___6; - FStar_Syntax_Syntax.lbpos = uu___7;_}::[]); - FStar_Syntax_Syntax.lids1 = uu___8;_} - when FStar_Syntax_Syntax.fv_eq_lid b2t FStar_Parser_Const.b2t_lid - -> - let uu___9 = - FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid env - (b2t.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v - Prims.int_one in - (match uu___9 with - | (tname, ttok, env1) -> - let xx = - FStar_SMTEncoding_Term.mk_fv - ("x", FStar_SMTEncoding_Term.Term_sort) in - let x = FStar_SMTEncoding_Util.mkFreeV xx in - let b2t_x = FStar_SMTEncoding_Util.mkApp ("Prims.b2t", [x]) in - let valid_b2t_x = - FStar_SMTEncoding_Util.mkApp ("Valid", [b2t_x]) in - let bool_ty = - let uu___10 = - FStar_Syntax_Syntax.withsort FStar_Parser_Const.bool_lid in - FStar_SMTEncoding_Env.lookup_free_var env1 uu___10 in - let decls = - let uu___10 = - let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = FStar_Syntax_Syntax.range_of_fv b2t in - let uu___15 = - let uu___16 = - let uu___17 = - let uu___18 = - FStar_SMTEncoding_Util.mkApp - ((FStar_Pervasives_Native.snd - FStar_SMTEncoding_Term.boxBoolFun), - [x]) in - (valid_b2t_x, uu___18) in - FStar_SMTEncoding_Util.mkEq uu___17 in - ([[b2t_x]], [xx], uu___16) in - FStar_SMTEncoding_Term.mkForall uu___14 uu___15 in - (uu___13, (FStar_Pervasives_Native.Some "b2t def"), - "b2t_def") in - FStar_SMTEncoding_Util.mkAssume uu___12 in - let uu___12 = - let uu___13 = - let uu___14 = - let uu___15 = - let uu___16 = FStar_Syntax_Syntax.range_of_fv b2t in - let uu___17 = - let uu___18 = - let uu___19 = - let uu___20 = - FStar_SMTEncoding_Term.mk_HasType x - bool_ty in - let uu___21 = - FStar_SMTEncoding_Term.mk_HasType b2t_x - FStar_SMTEncoding_Term.mk_Term_type in - (uu___20, uu___21) in - FStar_SMTEncoding_Util.mkImp uu___19 in - ([[b2t_x]], [xx], uu___18) in - FStar_SMTEncoding_Term.mkForall uu___16 uu___17 in - (uu___15, - (FStar_Pervasives_Native.Some "b2t typing"), - "b2t_typing") in - FStar_SMTEncoding_Util.mkAssume uu___14 in - [uu___13] in - uu___11 :: uu___12 in - (FStar_SMTEncoding_Term.DeclFun - (tname, [FStar_SMTEncoding_Term.Term_sort], - FStar_SMTEncoding_Term.Term_sort, - FStar_Pervasives_Native.None)) - :: uu___10 in - let uu___10 = FStar_SMTEncoding_Term.mk_decls_trivial decls in - (uu___10, env1)) - | FStar_Syntax_Syntax.Sig_let uu___1 when - FStar_Compiler_Util.for_some - (fun uu___2 -> - match uu___2 with - | FStar_Syntax_Syntax.Discriminator uu___3 -> true - | uu___3 -> false) se.FStar_Syntax_Syntax.sigquals - -> - ((let uu___3 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in - if uu___3 - then - let uu___4 = FStar_Syntax_Print.sigelt_to_string_short se in - FStar_Compiler_Util.print1 "Not encoding discriminator '%s'\n" - uu___4 - else ()); - ([], env)) - | FStar_Syntax_Syntax.Sig_let - { FStar_Syntax_Syntax.lbs1 = uu___1; - FStar_Syntax_Syntax.lids1 = lids;_} - when - (FStar_Compiler_Util.for_some - (fun l -> - let uu___2 = - let uu___3 = - let uu___4 = FStar_Ident.ns_of_lid l in - FStar_Compiler_List.hd uu___4 in - FStar_Ident.string_of_id uu___3 in - uu___2 = "Prims") lids) - && - (FStar_Compiler_Util.for_some - (fun uu___2 -> - match uu___2 with - | FStar_Syntax_Syntax.Unfold_for_unification_and_vcgen -> - true - | uu___3 -> false) se.FStar_Syntax_Syntax.sigquals) - -> - ((let uu___3 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in - if uu___3 - then - let uu___4 = FStar_Syntax_Print.sigelt_to_string_short se in - FStar_Compiler_Util.print1 - "Not encoding unfold let from Prims '%s'\n" uu___4 - else ()); - ([], env)) - | FStar_Syntax_Syntax.Sig_let - { FStar_Syntax_Syntax.lbs1 = (false, lb::[]); - FStar_Syntax_Syntax.lids1 = uu___1;_} - when - FStar_Compiler_Util.for_some - (fun uu___2 -> - match uu___2 with - | FStar_Syntax_Syntax.Projector uu___3 -> true - | uu___3 -> false) se.FStar_Syntax_Syntax.sigquals - -> - let fv = FStar_Compiler_Util.right lb.FStar_Syntax_Syntax.lbname in - let l = (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - let uu___2 = FStar_SMTEncoding_Env.try_lookup_free_var env l in - (match uu___2 with - | FStar_Pervasives_Native.Some uu___3 -> ([], env) - | FStar_Pervasives_Native.None -> - let se1 = - let uu___3 = FStar_Ident.range_of_lid l in - { - FStar_Syntax_Syntax.sigel = - (FStar_Syntax_Syntax.Sig_declare_typ - { - FStar_Syntax_Syntax.lid2 = l; - FStar_Syntax_Syntax.us2 = - (lb.FStar_Syntax_Syntax.lbunivs); - FStar_Syntax_Syntax.t2 = - (lb.FStar_Syntax_Syntax.lbtyp) - }); - FStar_Syntax_Syntax.sigrng = uu___3; - FStar_Syntax_Syntax.sigquals = - (se.FStar_Syntax_Syntax.sigquals); - FStar_Syntax_Syntax.sigmeta = - (se.FStar_Syntax_Syntax.sigmeta); - FStar_Syntax_Syntax.sigattrs = - (se.FStar_Syntax_Syntax.sigattrs); - FStar_Syntax_Syntax.sigopens_and_abbrevs = - (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); - FStar_Syntax_Syntax.sigopts = - (se.FStar_Syntax_Syntax.sigopts) - } in - encode_sigelt env se1) - | FStar_Syntax_Syntax.Sig_let - { FStar_Syntax_Syntax.lbs1 = (is_rec, bindings); - FStar_Syntax_Syntax.lids1 = uu___1;_} - -> - let bindings1 = - FStar_Compiler_List.map - (fun lb -> - let def = - norm_before_encoding env lb.FStar_Syntax_Syntax.lbdef in - let typ = - norm_before_encoding env lb.FStar_Syntax_Syntax.lbtyp in - { - FStar_Syntax_Syntax.lbname = - (lb.FStar_Syntax_Syntax.lbname); - FStar_Syntax_Syntax.lbunivs = - (lb.FStar_Syntax_Syntax.lbunivs); - FStar_Syntax_Syntax.lbtyp = typ; - FStar_Syntax_Syntax.lbeff = - (lb.FStar_Syntax_Syntax.lbeff); - FStar_Syntax_Syntax.lbdef = def; - FStar_Syntax_Syntax.lbattrs = - (lb.FStar_Syntax_Syntax.lbattrs); - FStar_Syntax_Syntax.lbpos = - (lb.FStar_Syntax_Syntax.lbpos) - }) bindings in - encode_top_level_let env (is_rec, bindings1) - se.FStar_Syntax_Syntax.sigquals - | FStar_Syntax_Syntax.Sig_bundle - { FStar_Syntax_Syntax.ses = ses; - FStar_Syntax_Syntax.lids = uu___1;_} - -> - let uu___2 = encode_sigelts env ses in - (match uu___2 with - | (g, env1) -> - let uu___3 = - FStar_Compiler_List.fold_left - (fun uu___4 -> - fun elt -> - match uu___4 with - | (g', inversions) -> - let uu___5 = - FStar_Compiler_List.partition - (fun uu___6 -> - match uu___6 with - | FStar_SMTEncoding_Term.Assume - { - FStar_SMTEncoding_Term.assumption_term - = uu___7; - FStar_SMTEncoding_Term.assumption_caption - = FStar_Pervasives_Native.Some - "inversion axiom"; - FStar_SMTEncoding_Term.assumption_name - = uu___8; - FStar_SMTEncoding_Term.assumption_fact_ids - = uu___9;_} - -> false - | uu___7 -> true) - elt.FStar_SMTEncoding_Term.decls in - (match uu___5 with - | (elt_g', elt_inversions) -> - ((FStar_Compiler_List.op_At g' - [{ - FStar_SMTEncoding_Term.sym_name = - (elt.FStar_SMTEncoding_Term.sym_name); - FStar_SMTEncoding_Term.key = - (elt.FStar_SMTEncoding_Term.key); - FStar_SMTEncoding_Term.decls = - elt_g'; - FStar_SMTEncoding_Term.a_names = - (elt.FStar_SMTEncoding_Term.a_names) - }]), - (FStar_Compiler_List.op_At inversions - elt_inversions)))) ([], []) g in - (match uu___3 with - | (g', inversions) -> - let uu___4 = - FStar_Compiler_List.fold_left - (fun uu___5 -> - fun elt -> - match uu___5 with - | (decls, elts, rest) -> - let uu___6 = - (FStar_Compiler_Util.is_some - elt.FStar_SMTEncoding_Term.key) - && - (FStar_Compiler_List.existsb - (fun uu___7 -> - match uu___7 with - | FStar_SMTEncoding_Term.DeclFun - uu___8 -> true - | uu___8 -> false) - elt.FStar_SMTEncoding_Term.decls) in - if uu___6 - then - (decls, - (FStar_Compiler_List.op_At elts [elt]), - rest) - else - (let uu___8 = - FStar_Compiler_List.partition - (fun uu___9 -> - match uu___9 with - | FStar_SMTEncoding_Term.DeclFun - uu___10 -> true - | uu___10 -> false) - elt.FStar_SMTEncoding_Term.decls in - match uu___8 with - | (elt_decls, elt_rest) -> - ((FStar_Compiler_List.op_At decls - elt_decls), elts, - (FStar_Compiler_List.op_At rest - [{ - FStar_SMTEncoding_Term.sym_name - = - (elt.FStar_SMTEncoding_Term.sym_name); - FStar_SMTEncoding_Term.key = - (elt.FStar_SMTEncoding_Term.key); - FStar_SMTEncoding_Term.decls - = elt_rest; - FStar_SMTEncoding_Term.a_names - = - (elt.FStar_SMTEncoding_Term.a_names) - }])))) ([], [], []) g' in - (match uu___4 with - | (decls, elts, rest) -> - let uu___5 = - let uu___6 = - FStar_SMTEncoding_Term.mk_decls_trivial decls in - let uu___7 = - let uu___8 = - let uu___9 = - FStar_SMTEncoding_Term.mk_decls_trivial - inversions in - FStar_Compiler_List.op_At rest uu___9 in - FStar_Compiler_List.op_At elts uu___8 in - FStar_Compiler_List.op_At uu___6 uu___7 in - (uu___5, env1)))) - | FStar_Syntax_Syntax.Sig_inductive_typ - { FStar_Syntax_Syntax.lid = t; - FStar_Syntax_Syntax.us = universe_names; - FStar_Syntax_Syntax.params = tps; - FStar_Syntax_Syntax.num_uniform_params = uu___1; - FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___2; - FStar_Syntax_Syntax.ds = datas;_} - -> - let t_lid = t in - let tcenv = env.FStar_SMTEncoding_Env.tcenv in - let is_injective_on_params = - let uu___3 = FStar_Syntax_Subst.univ_var_opening universe_names in - match uu___3 with - | (usubst, uvs) -> - let uu___4 = - let uu___5 = - FStar_TypeChecker_Env.push_univ_vars tcenv uvs in - let uu___6 = FStar_Syntax_Subst.subst_binders usubst tps in - let uu___7 = - let uu___8 = - FStar_Syntax_Subst.shift_subst - (FStar_Compiler_List.length tps) usubst in - FStar_Syntax_Subst.subst uu___8 k in - (uu___5, uu___6, uu___7) in - (match uu___4 with - | (env1, tps1, k1) -> - let uu___5 = FStar_Syntax_Subst.open_term tps1 k1 in - (match uu___5 with - | (tps2, k2) -> - let uu___6 = FStar_Syntax_Util.arrow_formals k2 in - (match uu___6 with - | (uu___7, k3) -> - let uu___8 = - FStar_TypeChecker_TcTerm.tc_binders env1 - tps2 in - (match uu___8 with - | (tps3, env_tps, uu___9, us) -> - let u_k = - let uu___10 = - let uu___11 = - FStar_Syntax_Syntax.fvar t - FStar_Pervasives_Native.None in - let uu___12 = - let uu___13 = - FStar_Syntax_Util.args_of_binders - tps3 in - FStar_Pervasives_Native.snd - uu___13 in - let uu___13 = - FStar_Ident.range_of_lid t in - FStar_Syntax_Syntax.mk_Tm_app - uu___11 uu___12 uu___13 in - FStar_TypeChecker_TcTerm.level_of_type - env_tps uu___10 k3 in - let rec universe_leq u v = - match (u, v) with - | (FStar_Syntax_Syntax.U_zero, - uu___10) -> true - | (FStar_Syntax_Syntax.U_succ u0, - FStar_Syntax_Syntax.U_succ v0) -> - universe_leq u0 v0 - | (FStar_Syntax_Syntax.U_name u0, - FStar_Syntax_Syntax.U_name v0) -> - FStar_Ident.ident_equals u0 v0 - | (FStar_Syntax_Syntax.U_name uu___10, - FStar_Syntax_Syntax.U_succ v0) -> - universe_leq u v0 - | (FStar_Syntax_Syntax.U_max us1, - uu___10) -> - FStar_Compiler_Util.for_all - (fun u1 -> universe_leq u1 v) - us1 - | (uu___10, FStar_Syntax_Syntax.U_max - vs) -> - FStar_Compiler_Util.for_some - (universe_leq u) vs - | (FStar_Syntax_Syntax.U_unknown, - uu___10) -> - let uu___11 = - let uu___12 = - FStar_Ident.string_of_lid t in - let uu___13 = - FStar_Syntax_Print.univ_to_string - u in - let uu___14 = - FStar_Syntax_Print.univ_to_string - v in - FStar_Compiler_Util.format3 - "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - uu___12 uu___13 uu___14 in - FStar_Compiler_Effect.failwith - uu___11 - | (uu___10, - FStar_Syntax_Syntax.U_unknown) -> - let uu___11 = - let uu___12 = - FStar_Ident.string_of_lid t in - let uu___13 = - FStar_Syntax_Print.univ_to_string - u in - let uu___14 = - FStar_Syntax_Print.univ_to_string - v in - FStar_Compiler_Util.format3 - "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - uu___12 uu___13 uu___14 in - FStar_Compiler_Effect.failwith - uu___11 - | (FStar_Syntax_Syntax.U_unif uu___10, - uu___11) -> - let uu___12 = - let uu___13 = - FStar_Ident.string_of_lid t in - let uu___14 = - FStar_Syntax_Print.univ_to_string - u in - let uu___15 = - FStar_Syntax_Print.univ_to_string - v in - FStar_Compiler_Util.format3 - "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - uu___13 uu___14 uu___15 in - FStar_Compiler_Effect.failwith - uu___12 - | (uu___10, FStar_Syntax_Syntax.U_unif - uu___11) -> - let uu___12 = - let uu___13 = - FStar_Ident.string_of_lid t in - let uu___14 = - FStar_Syntax_Print.univ_to_string - u in - let uu___15 = - FStar_Syntax_Print.univ_to_string - v in - FStar_Compiler_Util.format3 - "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - uu___13 uu___14 uu___15 in - FStar_Compiler_Effect.failwith - uu___12 - | uu___10 -> false in - let u_leq_u_k u = - let u1 = - FStar_TypeChecker_Normalize.normalize_universe - env_tps u in - universe_leq u1 u_k in - let tp_ok tp u_tp = - let t_tp = - (tp.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in - let uu___10 = u_leq_u_k u_tp in - if uu___10 - then true - else - (let t_tp1 = - FStar_TypeChecker_Normalize.normalize - [FStar_TypeChecker_Env.Unrefine; - FStar_TypeChecker_Env.Unascribe; - FStar_TypeChecker_Env.Unmeta; - FStar_TypeChecker_Env.Primops; - FStar_TypeChecker_Env.HNF; - FStar_TypeChecker_Env.UnfoldUntil - FStar_Syntax_Syntax.delta_constant; - FStar_TypeChecker_Env.Beta] - env_tps t_tp in - let uu___12 = - FStar_Syntax_Util.arrow_formals - t_tp1 in - match uu___12 with - | (formals, t1) -> - let uu___13 = - FStar_TypeChecker_TcTerm.tc_binders - env_tps formals in - (match uu___13 with - | (uu___14, uu___15, uu___16, - u_formals) -> - let inj = - FStar_Compiler_Util.for_all - (fun u_formal -> - u_leq_u_k u_formal) - u_formals in - if inj - then - let uu___17 = - let uu___18 = - FStar_Syntax_Subst.compress - t1 in - uu___18.FStar_Syntax_Syntax.n in - (match uu___17 with - | FStar_Syntax_Syntax.Tm_type - u -> u_leq_u_k u - | uu___18 -> false) - else false)) in - FStar_Compiler_List.forall2 tp_ok tps3 - us)))) in - ((let uu___4 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in - if uu___4 - then - let uu___5 = FStar_Ident.string_of_lid t in - FStar_Compiler_Util.print2 "%s injectivity for %s\n" - (if is_injective_on_params then "YES" else "NO") uu___5 - else ()); - (let quals = se.FStar_Syntax_Syntax.sigquals in - let is_logical = - FStar_Compiler_Util.for_some - (fun uu___4 -> - match uu___4 with - | FStar_Syntax_Syntax.Logic -> true - | FStar_Syntax_Syntax.Assumption -> true - | uu___5 -> false) quals in - let constructor_or_logic_type_decl c = - if is_logical - then - let uu___4 = - let uu___5 = - let uu___6 = - FStar_Compiler_List.map - (fun f -> f.FStar_SMTEncoding_Term.field_sort) - c.FStar_SMTEncoding_Term.constr_fields in - ((c.FStar_SMTEncoding_Term.constr_name), uu___6, - FStar_SMTEncoding_Term.Term_sort, - FStar_Pervasives_Native.None) in - FStar_SMTEncoding_Term.DeclFun uu___5 in - [uu___4] - else - (let uu___5 = FStar_Ident.range_of_lid t in - FStar_SMTEncoding_Term.constructor_to_decl uu___5 c) in - let inversion_axioms env1 tapp vars = - let uu___4 = - FStar_Compiler_Util.for_some - (fun l -> - let uu___5 = - FStar_TypeChecker_Env.try_lookup_lid - env1.FStar_SMTEncoding_Env.tcenv l in - FStar_Compiler_Option.isNone uu___5) datas in - if uu___4 - then [] - else - (let uu___6 = - FStar_SMTEncoding_Env.fresh_fvar - env1.FStar_SMTEncoding_Env.current_module_name "x" - FStar_SMTEncoding_Term.Term_sort in - match uu___6 with - | (xxsym, xx) -> - let uu___7 = - FStar_Compiler_List.fold_left - (fun uu___8 -> - fun l -> - match uu___8 with - | (out, decls) -> - let uu___9 = - FStar_TypeChecker_Env.lookup_datacon - env1.FStar_SMTEncoding_Env.tcenv l in - (match uu___9 with - | (uu___10, data_t) -> - let uu___11 = - FStar_Syntax_Util.arrow_formals - data_t in - (match uu___11 with - | (args, res) -> - let indices = - let uu___12 = - FStar_Syntax_Util.head_and_args_full - res in - FStar_Pervasives_Native.snd - uu___12 in - let env2 = - FStar_Compiler_List.fold_left - (fun env3 -> - fun uu___12 -> - match uu___12 with - | { - FStar_Syntax_Syntax.binder_bv - = x; - FStar_Syntax_Syntax.binder_qual - = uu___13; - FStar_Syntax_Syntax.binder_positivity - = uu___14; - FStar_Syntax_Syntax.binder_attrs - = uu___15;_} - -> - let uu___16 = - let uu___17 = - let uu___18 = - FStar_SMTEncoding_Env.mk_term_projector_name - l x in - (uu___18, [xx]) in - FStar_SMTEncoding_Util.mkApp - uu___17 in - FStar_SMTEncoding_Env.push_term_var - env3 x uu___16) - env1 args in - let uu___12 = - FStar_SMTEncoding_EncodeTerm.encode_args - indices env2 in - (match uu___12 with - | (indices1, decls') -> - (if - (FStar_Compiler_List.length - indices1) - <> - (FStar_Compiler_List.length - vars) - then - FStar_Compiler_Effect.failwith - "Impossible" - else (); - (let eqs = - let uu___14 = - is_injective_on_params - || - (let uu___15 = - FStar_Options.ext_getv - "compat:injectivity" in - uu___15 <> "") in - if uu___14 - then - FStar_Compiler_List.map2 - (fun v -> - fun a -> - let uu___15 = - let uu___16 - = - FStar_SMTEncoding_Util.mkFreeV - v in - (uu___16, a) in - FStar_SMTEncoding_Util.mkEq - uu___15) - vars indices1 - else - (let num_params = - FStar_Compiler_List.length - tps in - let uu___16 = - FStar_Compiler_List.splitAt - num_params vars in - match uu___16 with - | (_var_params, - var_indices) -> - let uu___17 = - FStar_Compiler_List.splitAt - num_params - indices1 in - (match uu___17 - with - | (_i_params, - indices2) -> - FStar_Compiler_List.map2 - ( - fun v -> - fun a -> - let uu___18 - = - let uu___19 - = - FStar_SMTEncoding_Util.mkFreeV - v in - (uu___19, - a) in - FStar_SMTEncoding_Util.mkEq - uu___18) - var_indices - indices2)) in - let uu___14 = - let uu___15 = - let uu___16 = - let uu___17 = - let uu___18 = - FStar_SMTEncoding_Env.mk_data_tester - env2 l xx in - let uu___19 = - FStar_SMTEncoding_Util.mk_and_l - eqs in - (uu___18, - uu___19) in - FStar_SMTEncoding_Util.mkAnd - uu___17 in - (out, uu___16) in - FStar_SMTEncoding_Util.mkOr - uu___15 in - (uu___14, - (FStar_Compiler_List.op_At - decls decls')))))))) - (FStar_SMTEncoding_Util.mkFalse, []) datas in - (match uu___7 with - | (data_ax, decls) -> - let uu___8 = - FStar_SMTEncoding_Env.fresh_fvar - env1.FStar_SMTEncoding_Env.current_module_name - "f" FStar_SMTEncoding_Term.Fuel_sort in - (match uu___8 with - | (ffsym, ff) -> - let fuel_guarded_inversion = - let xx_has_type_sfuel = - if - (FStar_Compiler_List.length datas) > - Prims.int_one - then - let uu___9 = - FStar_SMTEncoding_Util.mkApp - ("SFuel", [ff]) in - FStar_SMTEncoding_Term.mk_HasTypeFuel - uu___9 xx tapp - else - FStar_SMTEncoding_Term.mk_HasTypeFuel - ff xx tapp in - let uu___9 = - let uu___10 = - let uu___11 = - FStar_Ident.range_of_lid t in - let uu___12 = - let uu___13 = - let uu___14 = - FStar_SMTEncoding_Term.mk_fv - (ffsym, - FStar_SMTEncoding_Term.Fuel_sort) in - let uu___15 = - let uu___16 = - FStar_SMTEncoding_Term.mk_fv - (xxsym, - FStar_SMTEncoding_Term.Term_sort) in - uu___16 :: vars in - FStar_SMTEncoding_Env.add_fuel - uu___14 uu___15 in - let uu___14 = - FStar_SMTEncoding_Util.mkImp - (xx_has_type_sfuel, data_ax) in - ([[xx_has_type_sfuel]], uu___13, - uu___14) in - FStar_SMTEncoding_Term.mkForall uu___11 - uu___12 in - let uu___11 = - let uu___12 = - let uu___13 = - FStar_Ident.string_of_lid t in - Prims.strcat - "fuel_guarded_inversion_" uu___13 in - FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.mk_unique - uu___12 in - (uu___10, - (FStar_Pervasives_Native.Some - "inversion axiom"), uu___11) in - FStar_SMTEncoding_Util.mkAssume uu___9 in - let uu___9 = - FStar_SMTEncoding_Term.mk_decls_trivial - [fuel_guarded_inversion] in - FStar_Compiler_List.op_At decls uu___9))) in - let uu___4 = - let k1 = - match tps with - | [] -> k - | uu___5 -> - let uu___6 = - let uu___7 = - let uu___8 = FStar_Syntax_Syntax.mk_Total k in - { - FStar_Syntax_Syntax.bs1 = tps; - FStar_Syntax_Syntax.comp = uu___8 - } in - FStar_Syntax_Syntax.Tm_arrow uu___7 in - FStar_Syntax_Syntax.mk uu___6 k.FStar_Syntax_Syntax.pos in - let k2 = norm_before_encoding env k1 in - FStar_Syntax_Util.arrow_formals k2 in - match uu___4 with - | (formals, res) -> - let uu___5 = - FStar_SMTEncoding_EncodeTerm.encode_binders - FStar_Pervasives_Native.None formals env in - (match uu___5 with - | (vars, guards, env', binder_decls, uu___6) -> - let arity = FStar_Compiler_List.length vars in - let uu___7 = - FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid - env t arity in - (match uu___7 with - | (tname, ttok, env1) -> - let ttok_tm = - FStar_SMTEncoding_Util.mkApp (ttok, []) in - let guard = FStar_SMTEncoding_Util.mk_and_l guards in - let tapp = - let uu___8 = - let uu___9 = - FStar_Compiler_List.map - FStar_SMTEncoding_Util.mkFreeV vars in - (tname, uu___9) in - FStar_SMTEncoding_Util.mkApp uu___8 in - let uu___8 = - let tname_decl = - let uu___9 = - let uu___10 = - FStar_Compiler_List.map - (fun fv -> - let uu___11 = - let uu___12 = - FStar_SMTEncoding_Term.fv_name fv in - Prims.strcat tname uu___12 in - let uu___12 = - FStar_SMTEncoding_Term.fv_sort fv in + FStar_Syntax_Syntax.Tm_arrow uu___6 in + FStar_Syntax_Syntax.mk uu___5 k.FStar_Syntax_Syntax.pos in + let k2 = norm_before_encoding env k1 in + FStar_Syntax_Util.arrow_formals k2 in + (match uu___3 with + | (formals, res) -> + let uu___4 = + FStar_SMTEncoding_EncodeTerm.encode_binders + FStar_Pervasives_Native.None formals env in + (match uu___4 with + | (vars, guards, env', binder_decls, uu___5) -> + let arity = FStar_Compiler_List.length vars in + let uu___6 = + FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid + env t arity in + (match uu___6 with + | (tname, ttok, env1) -> + let ttok_tm = + FStar_SMTEncoding_Util.mkApp (ttok, []) in + let guard = FStar_SMTEncoding_Util.mk_and_l guards in + let tapp = + let uu___7 = + let uu___8 = + FStar_Compiler_List.map + FStar_SMTEncoding_Util.mkFreeV vars in + (tname, uu___8) in + FStar_SMTEncoding_Util.mkApp uu___7 in + let uu___7 = + let tname_decl = + let uu___8 = + let uu___9 = + FStar_Compiler_List.map + (fun fv -> + let uu___10 = + let uu___11 = + FStar_SMTEncoding_Term.fv_name fv in + Prims.strcat tname uu___11 in + let uu___11 = + FStar_SMTEncoding_Term.fv_sort fv in { FStar_SMTEncoding_Term.field_name = - uu___11; + uu___10; FStar_SMTEncoding_Term.field_sort = - uu___12; + uu___11; FStar_SMTEncoding_Term.field_projectible = false }) vars in - let uu___11 = - let uu___12 = + let uu___10 = + let uu___11 = FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id () in - FStar_Pervasives_Native.Some uu___12 in + FStar_Pervasives_Native.Some uu___11 in { FStar_SMTEncoding_Term.constr_name = tname; FStar_SMTEncoding_Term.constr_fields = - uu___10; + uu___9; FStar_SMTEncoding_Term.constr_sort = FStar_SMTEncoding_Term.Term_sort; - FStar_SMTEncoding_Term.constr_id = uu___11 + FStar_SMTEncoding_Term.constr_id = uu___10 } in - constructor_or_logic_type_decl uu___9 in - let uu___9 = + constructor_or_logic_type_decl uu___8 in + let uu___8 = match vars with | [] -> - let uu___10 = - let uu___11 = - let uu___12 = + let uu___9 = + let uu___10 = + let uu___11 = FStar_SMTEncoding_Util.mkApp (tname, []) in - FStar_Pervasives_Native.Some uu___12 in + FStar_Pervasives_Native.Some uu___11 in FStar_SMTEncoding_Env.push_free_var env1 - t arity tname uu___11 in - ([], uu___10) - | uu___10 -> + t arity tname uu___10 in + ([], uu___9) + | uu___9 -> let ttok_decl = FStar_SMTEncoding_Term.DeclFun (ttok, [], @@ -5037,328 +4329,342 @@ and (encode_sigelt' : (FStar_Pervasives_Native.Some "token")) in let ttok_fresh = - let uu___11 = + let uu___10 = FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id () in FStar_SMTEncoding_Term.fresh_token (ttok, FStar_SMTEncoding_Term.Term_sort) - uu___11 in + uu___10 in let ttok_app = FStar_SMTEncoding_EncodeTerm.mk_Apply ttok_tm vars in let pats = [[ttok_app]; [tapp]] in let name_tok_corr = - let uu___11 = - let uu___12 = - let uu___13 = + let uu___10 = + let uu___11 = + let uu___12 = FStar_Ident.range_of_lid t in - let uu___14 = - let uu___15 = + let uu___13 = + let uu___14 = FStar_SMTEncoding_Util.mkEq (ttok_app, tapp) in (pats, FStar_Pervasives_Native.None, - vars, uu___15) in + vars, uu___14) in FStar_SMTEncoding_Term.mkForall' - uu___13 uu___14 in - (uu___12, + uu___12 uu___13 in + (uu___11, (FStar_Pervasives_Native.Some "name-token correspondence"), (Prims.strcat "token_correspondence_" ttok)) in - FStar_SMTEncoding_Util.mkAssume uu___11 in + FStar_SMTEncoding_Util.mkAssume uu___10 in ([ttok_decl; ttok_fresh; name_tok_corr], env1) in - match uu___9 with + match uu___8 with | (tok_decls, env2) -> ((FStar_Compiler_List.op_At tname_decl tok_decls), env2) in - (match uu___8 with + (match uu___7 with | (decls, env2) -> let kindingAx = - let uu___9 = + let uu___8 = FStar_SMTEncoding_EncodeTerm.encode_term_pred FStar_Pervasives_Native.None res env' tapp in - match uu___9 with + match uu___8 with | (k1, decls1) -> let karr = if (FStar_Compiler_List.length formals) > Prims.int_zero then - let uu___10 = - let uu___11 = - let uu___12 = - let uu___13 = + let uu___9 = + let uu___10 = + let uu___11 = + let uu___12 = FStar_SMTEncoding_Term.mk_PreType ttok_tm in FStar_SMTEncoding_Term.mk_tester - "Tm_arrow" uu___13 in - (uu___12, + "Tm_arrow" uu___12 in + (uu___11, (FStar_Pervasives_Native.Some "kinding"), (Prims.strcat "pre_kinding_" ttok)) in FStar_SMTEncoding_Util.mkAssume - uu___11 in - [uu___10] + uu___10 in + [uu___9] else [] in let rng = FStar_Ident.range_of_lid t in let tot_fun_axioms = - let uu___10 = + let uu___9 = FStar_Compiler_List.map - (fun uu___11 -> + (fun uu___10 -> FStar_SMTEncoding_Util.mkTrue) vars in FStar_SMTEncoding_EncodeTerm.isTotFun_axioms - rng ttok_tm vars uu___10 true in - let uu___10 = - let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = - let uu___15 = - let uu___16 = - let uu___17 = - let uu___18 = - let uu___19 = + rng ttok_tm vars uu___9 true in + let uu___9 = + let uu___10 = + let uu___11 = + let uu___12 = + let uu___13 = + let uu___14 = + let uu___15 = + let uu___16 = + let uu___17 = + let uu___18 = FStar_SMTEncoding_Util.mkImp (guard, k1) in ([[tapp]], vars, - uu___19) in + uu___18) in FStar_SMTEncoding_Term.mkForall - rng uu___18 in - (tot_fun_axioms, uu___17) in + rng uu___17 in + (tot_fun_axioms, uu___16) in FStar_SMTEncoding_Util.mkAnd - uu___16 in - (uu___15, + uu___15 in + (uu___14, FStar_Pervasives_Native.None, (Prims.strcat "kinding_" ttok)) in FStar_SMTEncoding_Util.mkAssume - uu___14 in - [uu___13] in + uu___13 in + [uu___12] in FStar_Compiler_List.op_At karr - uu___12 in + uu___11 in FStar_SMTEncoding_Term.mk_decls_trivial - uu___11 in - FStar_Compiler_List.op_At decls1 - uu___10 in + uu___10 in + FStar_Compiler_List.op_At decls1 uu___9 in let aux = - let uu___9 = - let uu___10 = + let uu___8 = + let uu___9 = inversion_axioms env2 tapp vars in - let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = + let uu___10 = + let uu___11 = + let uu___12 = + let uu___13 = FStar_Ident.range_of_lid t in - pretype_axiom uu___14 env2 tapp + pretype_axiom uu___13 env2 tapp vars in - [uu___13] in + [uu___12] in FStar_SMTEncoding_Term.mk_decls_trivial - uu___12 in - FStar_Compiler_List.op_At uu___10 uu___11 in - FStar_Compiler_List.op_At kindingAx uu___9 in - let g = + uu___11 in + FStar_Compiler_List.op_At uu___9 uu___10 in + FStar_Compiler_List.op_At kindingAx uu___8 in + let uu___8 = let uu___9 = FStar_SMTEncoding_Term.mk_decls_trivial decls in FStar_Compiler_List.op_At uu___9 (FStar_Compiler_List.op_At binder_decls aux) in - (g, env2)))))) - | FStar_Syntax_Syntax.Sig_datacon - { FStar_Syntax_Syntax.lid1 = d; FStar_Syntax_Syntax.us1 = uu___1; - FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; - FStar_Syntax_Syntax.num_ty_params = n_tps; - FStar_Syntax_Syntax.mutuals1 = mutuals;_} - -> - let quals = se.FStar_Syntax_Syntax.sigquals in - let t1 = norm_before_encoding env t in - let uu___3 = FStar_Syntax_Util.arrow_formals t1 in - (match uu___3 with - | (formals, t_res) -> - let arity = FStar_Compiler_List.length formals in - let uu___4 = - FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid - env d arity in - (match uu___4 with - | (ddconstrsym, ddtok, env1) -> - let ddtok_tm = FStar_SMTEncoding_Util.mkApp (ddtok, []) in - let uu___5 = - FStar_SMTEncoding_Env.fresh_fvar - env1.FStar_SMTEncoding_Env.current_module_name "f" - FStar_SMTEncoding_Term.Fuel_sort in - (match uu___5 with - | (fuel_var, fuel_tm) -> - let s_fuel_tm = - FStar_SMTEncoding_Util.mkApp ("SFuel", [fuel_tm]) in - let uu___6 = - FStar_SMTEncoding_EncodeTerm.encode_binders - (FStar_Pervasives_Native.Some fuel_tm) formals - env1 in - (match uu___6 with - | (vars, guards, env', binder_decls, names) -> - let fields = - FStar_Compiler_List.mapi - (fun n -> - fun x -> - let uu___7 = - FStar_SMTEncoding_Env.mk_term_projector_name - d x in - { - FStar_SMTEncoding_Term.field_name = - uu___7; - FStar_SMTEncoding_Term.field_sort = - FStar_SMTEncoding_Term.Term_sort; - FStar_SMTEncoding_Term.field_projectible - = true - }) names in - let datacons = - let uu___7 = FStar_Ident.range_of_lid d in - let uu___8 = - let uu___9 = - let uu___10 = - FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id - () in - FStar_Pervasives_Native.Some uu___10 in - { - FStar_SMTEncoding_Term.constr_name = - ddconstrsym; - FStar_SMTEncoding_Term.constr_fields = - fields; - FStar_SMTEncoding_Term.constr_sort = - FStar_SMTEncoding_Term.Term_sort; - FStar_SMTEncoding_Term.constr_id = - uu___9 - } in - FStar_SMTEncoding_Term.constructor_to_decl - uu___7 uu___8 in - let app = - FStar_SMTEncoding_EncodeTerm.mk_Apply - ddtok_tm vars in - let guard = - FStar_SMTEncoding_Util.mk_and_l guards in - let xvars = - FStar_Compiler_List.map - FStar_SMTEncoding_Util.mkFreeV vars in - let dapp = - FStar_SMTEncoding_Util.mkApp - (ddconstrsym, xvars) in - let uu___7 = - FStar_SMTEncoding_EncodeTerm.encode_term_pred - FStar_Pervasives_Native.None t1 env1 - ddtok_tm in - (match uu___7 with - | (tok_typing, decls3) -> - let tok_typing1 = - match fields with - | uu___8::uu___9 -> - let ff = - FStar_SMTEncoding_Term.mk_fv - ("ty", - FStar_SMTEncoding_Term.Term_sort) in - let f = - FStar_SMTEncoding_Util.mkFreeV ff in - let vtok_app_l = - FStar_SMTEncoding_EncodeTerm.mk_Apply - ddtok_tm [ff] in - let vtok_app_r = - let uu___10 = - let uu___11 = - FStar_SMTEncoding_Term.mk_fv - (ddtok, - FStar_SMTEncoding_Term.Term_sort) in - [uu___11] in - FStar_SMTEncoding_EncodeTerm.mk_Apply - f uu___10 in - let uu___10 = - FStar_Ident.range_of_lid d in - let uu___11 = - let uu___12 = - FStar_SMTEncoding_Term.mk_NoHoist - f tok_typing in - ([[vtok_app_l]; [vtok_app_r]], - [ff], uu___12) in - FStar_SMTEncoding_Term.mkForall - uu___10 uu___11 - | uu___8 -> tok_typing in - let uu___8 = - let uu___9 = - FStar_SMTEncoding_EncodeTerm.encode_term - t_res env' in - match uu___9 with - | (t_res_tm, t_res_decls) -> - let uu___10 = - FStar_SMTEncoding_Term.mk_HasTypeWithFuel - (FStar_Pervasives_Native.Some - fuel_tm) dapp t_res_tm in - (uu___10, t_res_tm, t_res_decls) in - (match uu___8 with - | (ty_pred', t_res_tm, decls_pred) -> - let proxy_fresh = - match formals with - | [] -> [] - | uu___9 -> - let uu___10 = - let uu___11 = - FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id - () in - FStar_SMTEncoding_Term.fresh_token - (ddtok, - FStar_SMTEncoding_Term.Term_sort) - uu___11 in - [uu___10] in - let encode_elim uu___9 = - let uu___10 = - FStar_Syntax_Util.head_and_args - t_res in - match uu___10 with - | (head, args) -> - let uu___11 = - let uu___12 = - FStar_Syntax_Subst.compress - head in - uu___12.FStar_Syntax_Syntax.n in - (match uu___11 with - | FStar_Syntax_Syntax.Tm_uinst - ({ - FStar_Syntax_Syntax.n - = - FStar_Syntax_Syntax.Tm_fvar - fv; - FStar_Syntax_Syntax.pos - = uu___12; - FStar_Syntax_Syntax.vars - = uu___13; - FStar_Syntax_Syntax.hash_code - = uu___14;_}, - uu___15) - -> - let encoded_head_fvb = - FStar_SMTEncoding_Env.lookup_free_var_name - env' - fv.FStar_Syntax_Syntax.fv_name in - let uu___16 = - FStar_SMTEncoding_EncodeTerm.encode_args - args env' in - (match uu___16 with - | (encoded_args, - arg_decls) -> - let guards_for_parameter - orig_arg arg xv = - let fv1 = - match arg.FStar_SMTEncoding_Term.tm - with - | FStar_SMTEncoding_Term.FreeV - fv2 -> fv2 - | uu___17 -> - let uu___18 - = - let uu___19 + (uu___8, env2))))) +let (encode_datacon : + Prims.bool -> + FStar_SMTEncoding_Env.env_t -> + FStar_Syntax_Syntax.sigelt -> + (FStar_SMTEncoding_Term.decls_t * FStar_SMTEncoding_Env.env_t)) + = + fun is_injective_on_tparams -> + fun env -> + fun se -> + let uu___ = se.FStar_Syntax_Syntax.sigel in + match uu___ with + | FStar_Syntax_Syntax.Sig_datacon + { FStar_Syntax_Syntax.lid1 = d; FStar_Syntax_Syntax.us1 = uu___1; + FStar_Syntax_Syntax.t1 = t; + FStar_Syntax_Syntax.ty_lid = uu___2; + FStar_Syntax_Syntax.num_ty_params = n_tps; + FStar_Syntax_Syntax.mutuals1 = mutuals;_} + -> + let quals = se.FStar_Syntax_Syntax.sigquals in + let t1 = norm_before_encoding env t in + let uu___3 = FStar_Syntax_Util.arrow_formals t1 in + (match uu___3 with + | (formals, t_res) -> + let arity = FStar_Compiler_List.length formals in + let uu___4 = + FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid + env d arity in + (match uu___4 with + | (ddconstrsym, ddtok, env1) -> + let ddtok_tm = FStar_SMTEncoding_Util.mkApp (ddtok, []) in + let uu___5 = + FStar_SMTEncoding_Env.fresh_fvar + env1.FStar_SMTEncoding_Env.current_module_name "f" + FStar_SMTEncoding_Term.Fuel_sort in + (match uu___5 with + | (fuel_var, fuel_tm) -> + let s_fuel_tm = + FStar_SMTEncoding_Util.mkApp + ("SFuel", [fuel_tm]) in + let uu___6 = + FStar_SMTEncoding_EncodeTerm.encode_binders + (FStar_Pervasives_Native.Some fuel_tm) formals + env1 in + (match uu___6 with + | (vars, guards, env', binder_decls, names) -> + let fields = + FStar_Compiler_List.mapi + (fun n -> + fun x -> + let uu___7 = + FStar_SMTEncoding_Env.mk_term_projector_name + d x in + { + FStar_SMTEncoding_Term.field_name + = uu___7; + FStar_SMTEncoding_Term.field_sort + = + FStar_SMTEncoding_Term.Term_sort; + FStar_SMTEncoding_Term.field_projectible + = true + }) names in + let datacons = + let uu___7 = FStar_Ident.range_of_lid d in + let uu___8 = + let uu___9 = + let uu___10 = + FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id + () in + FStar_Pervasives_Native.Some uu___10 in + { + FStar_SMTEncoding_Term.constr_name = + ddconstrsym; + FStar_SMTEncoding_Term.constr_fields = + fields; + FStar_SMTEncoding_Term.constr_sort = + FStar_SMTEncoding_Term.Term_sort; + FStar_SMTEncoding_Term.constr_id = + uu___9 + } in + FStar_SMTEncoding_Term.constructor_to_decl + uu___7 uu___8 in + let app = + FStar_SMTEncoding_EncodeTerm.mk_Apply + ddtok_tm vars in + let guard = + FStar_SMTEncoding_Util.mk_and_l guards in + let xvars = + FStar_Compiler_List.map + FStar_SMTEncoding_Util.mkFreeV vars in + let dapp = + FStar_SMTEncoding_Util.mkApp + (ddconstrsym, xvars) in + let uu___7 = + FStar_SMTEncoding_EncodeTerm.encode_term_pred + FStar_Pervasives_Native.None t1 env1 + ddtok_tm in + (match uu___7 with + | (tok_typing, decls3) -> + let tok_typing1 = + match fields with + | uu___8::uu___9 -> + let ff = + FStar_SMTEncoding_Term.mk_fv + ("ty", + FStar_SMTEncoding_Term.Term_sort) in + let f = + FStar_SMTEncoding_Util.mkFreeV + ff in + let vtok_app_l = + FStar_SMTEncoding_EncodeTerm.mk_Apply + ddtok_tm [ff] in + let vtok_app_r = + let uu___10 = + let uu___11 = + FStar_SMTEncoding_Term.mk_fv + (ddtok, + FStar_SMTEncoding_Term.Term_sort) in + [uu___11] in + FStar_SMTEncoding_EncodeTerm.mk_Apply + f uu___10 in + let uu___10 = + FStar_Ident.range_of_lid d in + let uu___11 = + let uu___12 = + FStar_SMTEncoding_Term.mk_NoHoist + f tok_typing in + ([[vtok_app_l]; [vtok_app_r]], + [ff], uu___12) in + FStar_SMTEncoding_Term.mkForall + uu___10 uu___11 + | uu___8 -> tok_typing in + let uu___8 = + let uu___9 = + FStar_SMTEncoding_EncodeTerm.encode_term + t_res env' in + match uu___9 with + | (t_res_tm, t_res_decls) -> + let uu___10 = + FStar_SMTEncoding_Term.mk_HasTypeWithFuel + (FStar_Pervasives_Native.Some + fuel_tm) dapp t_res_tm in + (uu___10, t_res_tm, t_res_decls) in + (match uu___8 with + | (ty_pred', t_res_tm, decls_pred) -> + let proxy_fresh = + match formals with + | [] -> [] + | uu___9 -> + let uu___10 = + let uu___11 = + FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id + () in + FStar_SMTEncoding_Term.fresh_token + (ddtok, + FStar_SMTEncoding_Term.Term_sort) + uu___11 in + [uu___10] in + let encode_elim uu___9 = + let uu___10 = + FStar_Syntax_Util.head_and_args + t_res in + match uu___10 with + | (head, args) -> + let uu___11 = + let uu___12 = + FStar_Syntax_Subst.compress + head in + uu___12.FStar_Syntax_Syntax.n in + (match uu___11 with + | FStar_Syntax_Syntax.Tm_uinst + ({ + FStar_Syntax_Syntax.n + = + FStar_Syntax_Syntax.Tm_fvar + fv; + FStar_Syntax_Syntax.pos + = uu___12; + FStar_Syntax_Syntax.vars + = uu___13; + FStar_Syntax_Syntax.hash_code + = uu___14;_}, + uu___15) + -> + let encoded_head_fvb = + FStar_SMTEncoding_Env.lookup_free_var_name + env' + fv.FStar_Syntax_Syntax.fv_name in + let uu___16 = + FStar_SMTEncoding_EncodeTerm.encode_args + args env' in + (match uu___16 with + | (encoded_args, + arg_decls) -> + let guards_for_parameter + orig_arg arg xv = + let fv1 = + match arg.FStar_SMTEncoding_Term.tm + with + | FStar_SMTEncoding_Term.FreeV + fv2 -> fv2 + | uu___17 -> + let uu___18 + = + let uu___19 = let uu___20 = @@ -5367,15 +4673,15 @@ and (encode_sigelt' : FStar_Compiler_Util.format1 "Inductive type parameter %s must be a variable ; You may want to change it to an index." uu___20 in - (FStar_Errors_Codes.Fatal_NonVariableInductiveTypeParameter, + (FStar_Errors_Codes.Fatal_NonVariableInductiveTypeParameter, uu___19) in - FStar_Errors.raise_error - uu___18 - orig_arg.FStar_Syntax_Syntax.pos in - let guards1 = - FStar_Compiler_List.collect - (fun g -> - let uu___17 + FStar_Errors.raise_error + uu___18 + orig_arg.FStar_Syntax_Syntax.pos in + let guards1 = + FStar_Compiler_List.collect + (fun g -> + let uu___17 = let uu___18 = @@ -5384,31 +4690,32 @@ and (encode_sigelt' : FStar_Compiler_List.contains fv1 uu___18 in - if uu___17 - then + if uu___17 + then let uu___18 = FStar_SMTEncoding_Term.subst g fv1 xv in [uu___18] - else []) - guards in - FStar_SMTEncoding_Util.mk_and_l - guards1 in - let uu___17 = - let uu___18 = - FStar_Compiler_List.zip - args - encoded_args in - FStar_Compiler_List.fold_left - (fun uu___19 -> - fun uu___20 - -> - match + else []) + guards in + FStar_SMTEncoding_Util.mk_and_l + guards1 in + let uu___17 = + let uu___18 = + FStar_Compiler_List.zip + args + encoded_args in + FStar_Compiler_List.fold_left + (fun uu___19 -> + fun uu___20 + -> + match (uu___19, uu___20) - with - | ((env2, + with + | + ((env2, arg_vars, eqns_or_guards, i), @@ -5458,44 +4765,46 @@ and (encode_sigelt' : eqns, (i + Prims.int_one)))) - (env', [], [], - Prims.int_zero) - uu___18 in - (match uu___17 with - | (uu___18, - arg_vars, - elim_eqns_or_guards, - uu___19) -> - let arg_vars1 = - FStar_Compiler_List.rev - arg_vars in - let ty = - FStar_SMTEncoding_EncodeTerm.maybe_curry_fvb - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.p - encoded_head_fvb - arg_vars1 in - let xvars1 = - FStar_Compiler_List.map - FStar_SMTEncoding_Util.mkFreeV - vars in - let dapp1 = - FStar_SMTEncoding_Util.mkApp - (ddconstrsym, + (env', [], [], + Prims.int_zero) + uu___18 in + (match uu___17 with + | (uu___18, + arg_vars, + elim_eqns_or_guards, + uu___19) -> + let arg_vars1 + = + FStar_Compiler_List.rev + arg_vars in + let ty = + FStar_SMTEncoding_EncodeTerm.maybe_curry_fvb + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.p + encoded_head_fvb + arg_vars1 in + let xvars1 = + FStar_Compiler_List.map + FStar_SMTEncoding_Util.mkFreeV + vars in + let dapp1 = + FStar_SMTEncoding_Util.mkApp + (ddconstrsym, xvars1) in - let ty_pred = - FStar_SMTEncoding_Term.mk_HasTypeWithFuel - (FStar_Pervasives_Native.Some + let ty_pred = + FStar_SMTEncoding_Term.mk_HasTypeWithFuel + (FStar_Pervasives_Native.Some s_fuel_tm) - dapp1 ty in - let arg_binders - = - FStar_Compiler_List.map - FStar_SMTEncoding_Term.fv_of_term - arg_vars1 in - let typing_inversion - = - let uu___20 = - let uu___21 + dapp1 ty in + let arg_binders + = + FStar_Compiler_List.map + FStar_SMTEncoding_Term.fv_of_term + arg_vars1 in + let typing_inversion + = + let uu___20 + = + let uu___21 = let uu___22 = @@ -5536,19 +4845,18 @@ and (encode_sigelt' : FStar_SMTEncoding_Term.mkForall uu___22 uu___23 in - (uu___21, - ( - FStar_Pervasives_Native.Some + (uu___21, + (FStar_Pervasives_Native.Some "data constructor typing elim"), - ( - Prims.strcat + (Prims.strcat "data_elim_" ddconstrsym)) in - FStar_SMTEncoding_Util.mkAssume - uu___20 in - let lex_t = - let uu___20 = - let uu___21 + FStar_SMTEncoding_Util.mkAssume + uu___20 in + let lex_t = + let uu___20 + = + let uu___21 = let uu___22 = @@ -5556,14 +4864,14 @@ and (encode_sigelt' : FStar_Parser_Const.lex_t_lid in (uu___22, FStar_SMTEncoding_Term.Term_sort) in - FStar_SMTEncoding_Term.mk_fv + FStar_SMTEncoding_Term.mk_fv uu___21 in - FStar_SMTEncoding_Util.mkFreeV - uu___20 in - let subterm_ordering - = - let prec = - let uu___20 + FStar_SMTEncoding_Util.mkFreeV + uu___20 in + let subterm_ordering + = + let prec = + let uu___20 = FStar_Compiler_List.mapi (fun i -> @@ -5585,10 +4893,11 @@ and (encode_sigelt' : dapp1 in [uu___22])) vars in - FStar_Compiler_List.flatten + FStar_Compiler_List.flatten uu___20 in - let uu___20 = - let uu___21 + let uu___20 + = + let uu___21 = let uu___22 = @@ -5627,25 +4936,24 @@ and (encode_sigelt' : FStar_SMTEncoding_Term.mkForall uu___22 uu___23 in - (uu___21, - ( - FStar_Pervasives_Native.Some + (uu___21, + (FStar_Pervasives_Native.Some "subterm ordering"), - ( - Prims.strcat + (Prims.strcat "subterm_ordering_" ddconstrsym)) in - FStar_SMTEncoding_Util.mkAssume - uu___20 in - let uu___20 = - let uu___21 = - FStar_Compiler_Util.first_N + FStar_SMTEncoding_Util.mkAssume + uu___20 in + let uu___20 = + let uu___21 + = + FStar_Compiler_Util.first_N n_tps formals in - match uu___21 - with - | (uu___22, - formals') + match uu___21 + with + | (uu___22, + formals') -> let uu___23 = @@ -6076,41 +5384,41 @@ and (encode_sigelt' : [uu___28] in (uu___27, cod_decls)))) in - (match uu___20 - with - | (codomain_ordering, - codomain_decls) - -> - ((FStar_Compiler_List.op_At + (match uu___20 + with + | (codomain_ordering, + codomain_decls) + -> + ((FStar_Compiler_List.op_At arg_decls codomain_decls), (FStar_Compiler_List.op_At [typing_inversion; subterm_ordering] codomain_ordering))))) - | FStar_Syntax_Syntax.Tm_fvar - fv -> - let encoded_head_fvb = - FStar_SMTEncoding_Env.lookup_free_var_name - env' - fv.FStar_Syntax_Syntax.fv_name in - let uu___12 = - FStar_SMTEncoding_EncodeTerm.encode_args - args env' in - (match uu___12 with - | (encoded_args, - arg_decls) -> - let guards_for_parameter - orig_arg arg xv = - let fv1 = - match arg.FStar_SMTEncoding_Term.tm - with - | FStar_SMTEncoding_Term.FreeV - fv2 -> fv2 - | uu___13 -> - let uu___14 - = - let uu___15 + | FStar_Syntax_Syntax.Tm_fvar + fv -> + let encoded_head_fvb = + FStar_SMTEncoding_Env.lookup_free_var_name + env' + fv.FStar_Syntax_Syntax.fv_name in + let uu___12 = + FStar_SMTEncoding_EncodeTerm.encode_args + args env' in + (match uu___12 with + | (encoded_args, + arg_decls) -> + let guards_for_parameter + orig_arg arg xv = + let fv1 = + match arg.FStar_SMTEncoding_Term.tm + with + | FStar_SMTEncoding_Term.FreeV + fv2 -> fv2 + | uu___13 -> + let uu___14 + = + let uu___15 = let uu___16 = @@ -6119,15 +5427,15 @@ and (encode_sigelt' : FStar_Compiler_Util.format1 "Inductive type parameter %s must be a variable ; You may want to change it to an index." uu___16 in - (FStar_Errors_Codes.Fatal_NonVariableInductiveTypeParameter, + (FStar_Errors_Codes.Fatal_NonVariableInductiveTypeParameter, uu___15) in - FStar_Errors.raise_error - uu___14 - orig_arg.FStar_Syntax_Syntax.pos in - let guards1 = - FStar_Compiler_List.collect - (fun g -> - let uu___13 + FStar_Errors.raise_error + uu___14 + orig_arg.FStar_Syntax_Syntax.pos in + let guards1 = + FStar_Compiler_List.collect + (fun g -> + let uu___13 = let uu___14 = @@ -6136,31 +5444,32 @@ and (encode_sigelt' : FStar_Compiler_List.contains fv1 uu___14 in - if uu___13 - then + if uu___13 + then let uu___14 = FStar_SMTEncoding_Term.subst g fv1 xv in [uu___14] - else []) - guards in - FStar_SMTEncoding_Util.mk_and_l - guards1 in - let uu___13 = - let uu___14 = - FStar_Compiler_List.zip - args - encoded_args in - FStar_Compiler_List.fold_left - (fun uu___15 -> - fun uu___16 - -> - match + else []) + guards in + FStar_SMTEncoding_Util.mk_and_l + guards1 in + let uu___13 = + let uu___14 = + FStar_Compiler_List.zip + args + encoded_args in + FStar_Compiler_List.fold_left + (fun uu___15 -> + fun uu___16 + -> + match (uu___15, uu___16) - with - | ((env2, + with + | + ((env2, arg_vars, eqns_or_guards, i), @@ -6210,44 +5519,46 @@ and (encode_sigelt' : eqns, (i + Prims.int_one)))) - (env', [], [], - Prims.int_zero) - uu___14 in - (match uu___13 with - | (uu___14, - arg_vars, - elim_eqns_or_guards, - uu___15) -> - let arg_vars1 = - FStar_Compiler_List.rev - arg_vars in - let ty = - FStar_SMTEncoding_EncodeTerm.maybe_curry_fvb - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.p - encoded_head_fvb - arg_vars1 in - let xvars1 = - FStar_Compiler_List.map - FStar_SMTEncoding_Util.mkFreeV - vars in - let dapp1 = - FStar_SMTEncoding_Util.mkApp - (ddconstrsym, + (env', [], [], + Prims.int_zero) + uu___14 in + (match uu___13 with + | (uu___14, + arg_vars, + elim_eqns_or_guards, + uu___15) -> + let arg_vars1 + = + FStar_Compiler_List.rev + arg_vars in + let ty = + FStar_SMTEncoding_EncodeTerm.maybe_curry_fvb + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.p + encoded_head_fvb + arg_vars1 in + let xvars1 = + FStar_Compiler_List.map + FStar_SMTEncoding_Util.mkFreeV + vars in + let dapp1 = + FStar_SMTEncoding_Util.mkApp + (ddconstrsym, xvars1) in - let ty_pred = - FStar_SMTEncoding_Term.mk_HasTypeWithFuel - (FStar_Pervasives_Native.Some + let ty_pred = + FStar_SMTEncoding_Term.mk_HasTypeWithFuel + (FStar_Pervasives_Native.Some s_fuel_tm) - dapp1 ty in - let arg_binders - = - FStar_Compiler_List.map - FStar_SMTEncoding_Term.fv_of_term - arg_vars1 in - let typing_inversion - = - let uu___16 = - let uu___17 + dapp1 ty in + let arg_binders + = + FStar_Compiler_List.map + FStar_SMTEncoding_Term.fv_of_term + arg_vars1 in + let typing_inversion + = + let uu___16 + = + let uu___17 = let uu___18 = @@ -6288,19 +5599,18 @@ and (encode_sigelt' : FStar_SMTEncoding_Term.mkForall uu___18 uu___19 in - (uu___17, - ( - FStar_Pervasives_Native.Some + (uu___17, + (FStar_Pervasives_Native.Some "data constructor typing elim"), - ( - Prims.strcat + (Prims.strcat "data_elim_" ddconstrsym)) in - FStar_SMTEncoding_Util.mkAssume - uu___16 in - let lex_t = - let uu___16 = - let uu___17 + FStar_SMTEncoding_Util.mkAssume + uu___16 in + let lex_t = + let uu___16 + = + let uu___17 = let uu___18 = @@ -6308,14 +5618,14 @@ and (encode_sigelt' : FStar_Parser_Const.lex_t_lid in (uu___18, FStar_SMTEncoding_Term.Term_sort) in - FStar_SMTEncoding_Term.mk_fv + FStar_SMTEncoding_Term.mk_fv uu___17 in - FStar_SMTEncoding_Util.mkFreeV - uu___16 in - let subterm_ordering - = - let prec = - let uu___16 + FStar_SMTEncoding_Util.mkFreeV + uu___16 in + let subterm_ordering + = + let prec = + let uu___16 = FStar_Compiler_List.mapi (fun i -> @@ -6337,10 +5647,11 @@ and (encode_sigelt' : dapp1 in [uu___18])) vars in - FStar_Compiler_List.flatten + FStar_Compiler_List.flatten uu___16 in - let uu___16 = - let uu___17 + let uu___16 + = + let uu___17 = let uu___18 = @@ -6379,25 +5690,24 @@ and (encode_sigelt' : FStar_SMTEncoding_Term.mkForall uu___18 uu___19 in - (uu___17, - ( - FStar_Pervasives_Native.Some + (uu___17, + (FStar_Pervasives_Native.Some "subterm ordering"), - ( - Prims.strcat + (Prims.strcat "subterm_ordering_" ddconstrsym)) in - FStar_SMTEncoding_Util.mkAssume - uu___16 in - let uu___16 = - let uu___17 = - FStar_Compiler_Util.first_N + FStar_SMTEncoding_Util.mkAssume + uu___16 in + let uu___16 = + let uu___17 + = + FStar_Compiler_Util.first_N n_tps formals in - match uu___17 - with - | (uu___18, - formals') + match uu___17 + with + | (uu___18, + formals') -> let uu___19 = @@ -6828,71 +6138,72 @@ and (encode_sigelt' : [uu___24] in (uu___23, cod_decls)))) in - (match uu___16 - with - | (codomain_ordering, - codomain_decls) - -> - ((FStar_Compiler_List.op_At + (match uu___16 + with + | (codomain_ordering, + codomain_decls) + -> + ((FStar_Compiler_List.op_At arg_decls codomain_decls), (FStar_Compiler_List.op_At [typing_inversion; subterm_ordering] codomain_ordering))))) - | uu___12 -> - ((let uu___14 = - let uu___15 = - let uu___16 = - FStar_Syntax_Print.lid_to_string - d in - let uu___17 = - FStar_Syntax_Print.term_to_string - head in - FStar_Compiler_Util.format2 - "Constructor %s builds an unexpected type %s\n" - uu___16 uu___17 in - (FStar_Errors_Codes.Warning_ConstructorBuildsUnexpectedType, - uu___15) in - FStar_Errors.log_issue - se.FStar_Syntax_Syntax.sigrng - uu___14); - ([], []))) in - let uu___9 = encode_elim () in - (match uu___9 with - | (decls2, elim) -> - let data_cons_typing_intro_decl - = - let uu___10 = - match t_res_tm.FStar_SMTEncoding_Term.tm - with - | FStar_SMTEncoding_Term.App - (op, args) -> - let uu___11 = - FStar_Compiler_List.splitAt - n_tps args in - (match uu___11 with - | (targs, iargs) -> - let uu___12 = - let uu___13 = - FStar_Compiler_List.map - (fun uu___14 + | uu___12 -> + ((let uu___14 = + let uu___15 = + let uu___16 = + FStar_Syntax_Print.lid_to_string + d in + let uu___17 = + FStar_Syntax_Print.term_to_string + head in + FStar_Compiler_Util.format2 + "Constructor %s builds an unexpected type %s\n" + uu___16 uu___17 in + (FStar_Errors_Codes.Warning_ConstructorBuildsUnexpectedType, + uu___15) in + FStar_Errors.log_issue + se.FStar_Syntax_Syntax.sigrng + uu___14); + ([], []))) in + let uu___9 = encode_elim () in + (match uu___9 with + | (decls2, elim) -> + let data_cons_typing_intro_decl + = + let uu___10 = + match t_res_tm.FStar_SMTEncoding_Term.tm + with + | FStar_SMTEncoding_Term.App + (op, args) -> + let uu___11 = + FStar_Compiler_List.splitAt + n_tps args in + (match uu___11 with + | (targs, iargs) -> + let uu___12 = + let uu___13 = + FStar_Compiler_List.map + (fun + uu___14 -> FStar_SMTEncoding_Env.fresh_fvar env1.FStar_SMTEncoding_Env.current_module_name "i" FStar_SMTEncoding_Term.Term_sort) - iargs in - FStar_Compiler_List.split - uu___13 in - (match uu___12 - with - | (fresh_ivars, - fresh_iargs) - -> - let additional_guards - = - let uu___13 + iargs in + FStar_Compiler_List.split + uu___13 in + (match uu___12 + with + | (fresh_ivars, + fresh_iargs) + -> + let additional_guards + = + let uu___13 = FStar_Compiler_List.map2 (fun a -> @@ -6904,12 +6215,12 @@ and (encode_sigelt' : fresh_a)) iargs fresh_iargs in - FStar_SMTEncoding_Util.mk_and_l + FStar_SMTEncoding_Util.mk_and_l uu___13 in - let uu___13 = - FStar_SMTEncoding_Term.mk_HasTypeWithFuel - ( - FStar_Pervasives_Native.Some + let uu___13 + = + FStar_SMTEncoding_Term.mk_HasTypeWithFuel + (FStar_Pervasives_Native.Some fuel_tm) dapp { @@ -6927,8 +6238,9 @@ and (encode_sigelt' : = (t_res_tm.FStar_SMTEncoding_Term.rng) } in - let uu___14 = - let uu___15 + let uu___14 + = + let uu___15 = FStar_Compiler_List.map (fun s -> @@ -6936,61 +6248,65 @@ and (encode_sigelt' : (s, FStar_SMTEncoding_Term.Term_sort)) fresh_ivars in - FStar_Compiler_List.op_At + FStar_Compiler_List.op_At vars uu___15 in - let uu___15 = - FStar_SMTEncoding_Util.mkAnd + let uu___15 + = + FStar_SMTEncoding_Util.mkAnd (guard, additional_guards) in - (uu___13, - uu___14, - uu___15))) - | uu___11 -> - (ty_pred', vars, guard) in - match uu___10 with - | (ty_pred'1, vars1, guard1) - -> - let uu___11 = - let uu___12 = - let uu___13 = - FStar_Ident.range_of_lid - d in - let uu___14 = - let uu___15 = - let uu___16 = - FStar_SMTEncoding_Term.mk_fv - (fuel_var, - FStar_SMTEncoding_Term.Fuel_sort) in - FStar_SMTEncoding_Env.add_fuel - uu___16 vars1 in - let uu___16 = - FStar_SMTEncoding_Util.mkImp - (guard1, - ty_pred'1) in - ([[ty_pred'1]], - uu___15, uu___16) in - FStar_SMTEncoding_Term.mkForall - uu___13 uu___14 in - (uu___12, - (FStar_Pervasives_Native.Some - "data constructor typing intro"), - (Prims.strcat - "data_typing_intro_" - ddtok)) in - FStar_SMTEncoding_Util.mkAssume - uu___11 in - let g = - let uu___10 = - let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = - let uu___15 = - let uu___16 = - let uu___17 = - let uu___18 = - let uu___19 + (uu___13, + uu___14, + uu___15))) + | uu___11 -> + (ty_pred', vars, + guard) in + match uu___10 with + | (ty_pred'1, vars1, guard1) + -> + let uu___11 = + let uu___12 = + let uu___13 = + FStar_Ident.range_of_lid + d in + let uu___14 = + let uu___15 = + let uu___16 = + FStar_SMTEncoding_Term.mk_fv + (fuel_var, + FStar_SMTEncoding_Term.Fuel_sort) in + FStar_SMTEncoding_Env.add_fuel + uu___16 vars1 in + let uu___16 = + FStar_SMTEncoding_Util.mkImp + (guard1, + ty_pred'1) in + ([[ty_pred'1]], + uu___15, + uu___16) in + FStar_SMTEncoding_Term.mkForall + uu___13 uu___14 in + (uu___12, + (FStar_Pervasives_Native.Some + "data constructor typing intro"), + (Prims.strcat + "data_typing_intro_" + ddtok)) in + FStar_SMTEncoding_Util.mkAssume + uu___11 in + let g = + let uu___10 = + let uu___11 = + let uu___12 = + let uu___13 = + let uu___14 = + let uu___15 = + let uu___16 = + let uu___17 = + let uu___18 + = + let uu___19 = let uu___20 = @@ -6999,36 +6315,35 @@ and (encode_sigelt' : FStar_Compiler_Util.format1 "data constructor proxy: %s" uu___20 in - FStar_Pervasives_Native.Some + FStar_Pervasives_Native.Some uu___19 in - (ddtok, [], - FStar_SMTEncoding_Term.Term_sort, - uu___18) in - FStar_SMTEncoding_Term.DeclFun - uu___17 in - [uu___16] in - FStar_Compiler_List.op_At - uu___15 - proxy_fresh in - FStar_SMTEncoding_Term.mk_decls_trivial - uu___14 in - let uu___14 = - let uu___15 = - let uu___16 = - let uu___17 = - let uu___18 = - FStar_SMTEncoding_Util.mkAssume - (tok_typing1, - ( - FStar_Pervasives_Native.Some + (ddtok, [], + FStar_SMTEncoding_Term.Term_sort, + uu___18) in + FStar_SMTEncoding_Term.DeclFun + uu___17 in + [uu___16] in + FStar_Compiler_List.op_At + uu___15 + proxy_fresh in + FStar_SMTEncoding_Term.mk_decls_trivial + uu___14 in + let uu___14 = + let uu___15 = + let uu___16 = + let uu___17 = + let uu___18 = + FStar_SMTEncoding_Util.mkAssume + (tok_typing1, + (FStar_Pervasives_Native.Some "typing for data constructor proxy"), - ( - Prims.strcat + (Prims.strcat "typing_tok_" ddtok)) in - let uu___19 = - let uu___20 = - let uu___21 + let uu___19 = + let uu___20 + = + let uu___21 = let uu___22 = @@ -7055,49 +6370,797 @@ and (encode_sigelt' : (Prims.strcat "equality_tok_" ddtok)) in - FStar_SMTEncoding_Util.mkAssume + FStar_SMTEncoding_Util.mkAssume uu___21 in - [uu___20; - data_cons_typing_intro_decl] in - uu___18 :: - uu___19 in - FStar_Compiler_List.op_At - uu___17 elim in - FStar_SMTEncoding_Term.mk_decls_trivial - uu___16 in - FStar_Compiler_List.op_At - decls_pred uu___15 in - FStar_Compiler_List.op_At - uu___13 uu___14 in - FStar_Compiler_List.op_At - decls3 uu___12 in - FStar_Compiler_List.op_At - decls2 uu___11 in - FStar_Compiler_List.op_At - binder_decls uu___10 in - let uu___10 = - let uu___11 = - FStar_SMTEncoding_Term.mk_decls_trivial - datacons in - FStar_Compiler_List.op_At - uu___11 g in - (uu___10, env1))))))))) -and (encode_sigelts : + [uu___20; + data_cons_typing_intro_decl] in + uu___18 :: + uu___19 in + FStar_Compiler_List.op_At + uu___17 elim in + FStar_SMTEncoding_Term.mk_decls_trivial + uu___16 in + FStar_Compiler_List.op_At + decls_pred uu___15 in + FStar_Compiler_List.op_At + uu___13 uu___14 in + FStar_Compiler_List.op_At + decls3 uu___12 in + FStar_Compiler_List.op_At + decls2 uu___11 in + FStar_Compiler_List.op_At + binder_decls uu___10 in + let uu___10 = + let uu___11 = + FStar_SMTEncoding_Term.mk_decls_trivial + datacons in + FStar_Compiler_List.op_At + uu___11 g in + (uu___10, env1)))))))) +let rec (encode_sigelt : FStar_SMTEncoding_Env.env_t -> - FStar_Syntax_Syntax.sigelt Prims.list -> + FStar_Syntax_Syntax.sigelt -> (FStar_SMTEncoding_Term.decls_t * FStar_SMTEncoding_Env.env_t)) = fun env -> - fun ses -> - FStar_Compiler_List.fold_left - (fun uu___ -> - fun se -> - match uu___ with - | (g, env1) -> - let uu___1 = encode_sigelt env1 se in - (match uu___1 with - | (g', env2) -> ((FStar_Compiler_List.op_At g g'), env2))) - ([], env) ses + fun se -> + let nm = FStar_Syntax_Print.sigelt_to_string_short se in + let uu___ = + let uu___1 = + let uu___2 = FStar_Syntax_Print.sigelt_to_string_short se in + FStar_Compiler_Util.format1 + "While encoding top-level declaration `%s`" uu___2 in + FStar_Errors.with_ctx uu___1 (fun uu___2 -> encode_sigelt' env se) in + match uu___ with + | (g, env1) -> + let g1 = + match g with + | [] -> + ((let uu___2 = + FStar_TypeChecker_Env.debug + env1.FStar_SMTEncoding_Env.tcenv + (FStar_Options.Other "SMTEncoding") in + if uu___2 + then + FStar_Compiler_Util.print1 "Skipped encoding of %s\n" nm + else ()); + (let uu___2 = + let uu___3 = + let uu___4 = + FStar_Compiler_Util.format1 "" nm in + FStar_SMTEncoding_Term.Caption uu___4 in + [uu___3] in + FStar_SMTEncoding_Term.mk_decls_trivial uu___2)) + | uu___1 -> + let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = + FStar_Compiler_Util.format1 "" nm in + FStar_SMTEncoding_Term.Caption uu___5 in + [uu___4] in + FStar_SMTEncoding_Term.mk_decls_trivial uu___3 in + let uu___3 = + let uu___4 = + let uu___5 = + let uu___6 = + let uu___7 = + FStar_Compiler_Util.format1 "" nm in + FStar_SMTEncoding_Term.Caption uu___7 in + [uu___6] in + FStar_SMTEncoding_Term.mk_decls_trivial uu___5 in + FStar_Compiler_List.op_At g uu___4 in + FStar_Compiler_List.op_At uu___2 uu___3 in + (g1, env1) +and (encode_sigelt' : + FStar_SMTEncoding_Env.env_t -> + FStar_Syntax_Syntax.sigelt -> + (FStar_SMTEncoding_Term.decls_t * FStar_SMTEncoding_Env.env_t)) + = + fun env -> + fun se -> + (let uu___1 = + FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv + (FStar_Options.Other "SMTEncoding") in + if uu___1 + then + let uu___2 = FStar_Syntax_Print.sigelt_to_string se in + FStar_Compiler_Util.print1 "@@@Encoding sigelt %s\n" uu___2 + else ()); + (let is_opaque_to_smt t = + let uu___1 = + let uu___2 = FStar_Syntax_Subst.compress t in + uu___2.FStar_Syntax_Syntax.n in + match uu___1 with + | FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_string + (s, uu___2)) -> s = "opaque_to_smt" + | uu___2 -> false in + let is_uninterpreted_by_smt t = + let uu___1 = + let uu___2 = FStar_Syntax_Subst.compress t in + uu___2.FStar_Syntax_Syntax.n in + match uu___1 with + | FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_string + (s, uu___2)) -> s = "uninterpreted_by_smt" + | uu___2 -> false in + match se.FStar_Syntax_Syntax.sigel with + | FStar_Syntax_Syntax.Sig_splice uu___1 -> + FStar_Compiler_Effect.failwith + "impossible -- splice should have been removed by Tc.fs" + | FStar_Syntax_Syntax.Sig_fail uu___1 -> + FStar_Compiler_Effect.failwith + "impossible -- Sig_fail should have been removed by Tc.fs" + | FStar_Syntax_Syntax.Sig_pragma uu___1 -> ([], env) + | FStar_Syntax_Syntax.Sig_effect_abbrev uu___1 -> ([], env) + | FStar_Syntax_Syntax.Sig_sub_effect uu___1 -> ([], env) + | FStar_Syntax_Syntax.Sig_polymonadic_bind uu___1 -> ([], env) + | FStar_Syntax_Syntax.Sig_polymonadic_subcomp uu___1 -> ([], env) + | FStar_Syntax_Syntax.Sig_new_effect ed -> + let uu___1 = + let uu___2 = + FStar_SMTEncoding_Util.is_smt_reifiable_effect + env.FStar_SMTEncoding_Env.tcenv ed.FStar_Syntax_Syntax.mname in + Prims.op_Negation uu___2 in + if uu___1 + then ([], env) + else + (let close_effect_params tm = + match ed.FStar_Syntax_Syntax.binders with + | [] -> tm + | uu___3 -> + FStar_Syntax_Syntax.mk + (FStar_Syntax_Syntax.Tm_abs + { + FStar_Syntax_Syntax.bs = + (ed.FStar_Syntax_Syntax.binders); + FStar_Syntax_Syntax.body = tm; + FStar_Syntax_Syntax.rc_opt = + (FStar_Pervasives_Native.Some + (FStar_Syntax_Util.mk_residual_comp + FStar_Parser_Const.effect_Tot_lid + FStar_Pervasives_Native.None + [FStar_Syntax_Syntax.TOTAL])) + }) tm.FStar_Syntax_Syntax.pos in + let encode_action env1 a = + let action_defn = + let uu___3 = + close_effect_params a.FStar_Syntax_Syntax.action_defn in + norm_before_encoding env1 uu___3 in + let uu___3 = + FStar_Syntax_Util.arrow_formals_comp + a.FStar_Syntax_Syntax.action_typ in + match uu___3 with + | (formals, uu___4) -> + let arity = FStar_Compiler_List.length formals in + let uu___5 = + FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid + env1 a.FStar_Syntax_Syntax.action_name arity in + (match uu___5 with + | (aname, atok, env2) -> + let uu___6 = + FStar_SMTEncoding_EncodeTerm.encode_term + action_defn env2 in + (match uu___6 with + | (tm, decls) -> + let a_decls = + let uu___7 = + let uu___8 = + let uu___9 = + FStar_Compiler_List.map + (fun uu___10 -> + FStar_SMTEncoding_Term.Term_sort) + formals in + (aname, uu___9, + FStar_SMTEncoding_Term.Term_sort, + (FStar_Pervasives_Native.Some "Action")) in + FStar_SMTEncoding_Term.DeclFun uu___8 in + [uu___7; + FStar_SMTEncoding_Term.DeclFun + (atok, [], + FStar_SMTEncoding_Term.Term_sort, + (FStar_Pervasives_Native.Some + "Action token"))] in + let uu___7 = + let aux uu___8 uu___9 = + match (uu___8, uu___9) with + | ({ FStar_Syntax_Syntax.binder_bv = bv; + FStar_Syntax_Syntax.binder_qual = + uu___10; + FStar_Syntax_Syntax.binder_positivity + = uu___11; + FStar_Syntax_Syntax.binder_attrs = + uu___12;_}, + (env3, acc_sorts, acc)) -> + let uu___13 = + FStar_SMTEncoding_Env.gen_term_var + env3 bv in + (match uu___13 with + | (xxsym, xx, env4) -> + let uu___14 = + let uu___15 = + FStar_SMTEncoding_Term.mk_fv + (xxsym, + FStar_SMTEncoding_Term.Term_sort) in + uu___15 :: acc_sorts in + (env4, uu___14, (xx :: acc))) in + FStar_Compiler_List.fold_right aux formals + (env2, [], []) in + (match uu___7 with + | (uu___8, xs_sorts, xs) -> + let app = + FStar_SMTEncoding_Util.mkApp (aname, xs) in + let a_eq = + let uu___9 = + let uu___10 = + let uu___11 = + FStar_Ident.range_of_lid + a.FStar_Syntax_Syntax.action_name in + let uu___12 = + let uu___13 = + let uu___14 = + let uu___15 = + FStar_SMTEncoding_EncodeTerm.mk_Apply + tm xs_sorts in + (app, uu___15) in + FStar_SMTEncoding_Util.mkEq + uu___14 in + ([[app]], xs_sorts, uu___13) in + FStar_SMTEncoding_Term.mkForall + uu___11 uu___12 in + (uu___10, + (FStar_Pervasives_Native.Some + "Action equality"), + (Prims.strcat aname "_equality")) in + FStar_SMTEncoding_Util.mkAssume uu___9 in + let tok_correspondence = + let tok_term = + let uu___9 = + FStar_SMTEncoding_Term.mk_fv + (atok, + FStar_SMTEncoding_Term.Term_sort) in + FStar_SMTEncoding_Util.mkFreeV uu___9 in + let tok_app = + FStar_SMTEncoding_EncodeTerm.mk_Apply + tok_term xs_sorts in + let uu___9 = + let uu___10 = + let uu___11 = + FStar_Ident.range_of_lid + a.FStar_Syntax_Syntax.action_name in + let uu___12 = + let uu___13 = + FStar_SMTEncoding_Util.mkEq + (tok_app, app) in + ([[tok_app]], xs_sorts, uu___13) in + FStar_SMTEncoding_Term.mkForall + uu___11 uu___12 in + (uu___10, + (FStar_Pervasives_Native.Some + "Action token correspondence"), + (Prims.strcat aname + "_token_correspondence")) in + FStar_SMTEncoding_Util.mkAssume uu___9 in + let uu___9 = + let uu___10 = + FStar_SMTEncoding_Term.mk_decls_trivial + (FStar_Compiler_List.op_At a_decls + [a_eq; tok_correspondence]) in + FStar_Compiler_List.op_At decls uu___10 in + (env2, uu___9)))) in + let uu___3 = + FStar_Compiler_Util.fold_map encode_action env + ed.FStar_Syntax_Syntax.actions in + match uu___3 with + | (env1, decls2) -> + ((FStar_Compiler_List.flatten decls2), env1)) + | FStar_Syntax_Syntax.Sig_declare_typ + { FStar_Syntax_Syntax.lid2 = lid; + FStar_Syntax_Syntax.us2 = uu___1; + FStar_Syntax_Syntax.t2 = uu___2;_} + when FStar_Ident.lid_equals lid FStar_Parser_Const.precedes_lid -> + let uu___3 = + FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid env lid + (Prims.of_int (4)) in + (match uu___3 with | (tname, ttok, env1) -> ([], env1)) + | FStar_Syntax_Syntax.Sig_declare_typ + { FStar_Syntax_Syntax.lid2 = lid; + FStar_Syntax_Syntax.us2 = uu___1; FStar_Syntax_Syntax.t2 = t;_} + -> + let quals = se.FStar_Syntax_Syntax.sigquals in + let will_encode_definition = + let uu___2 = + FStar_Compiler_Util.for_some + (fun uu___3 -> + match uu___3 with + | FStar_Syntax_Syntax.Assumption -> true + | FStar_Syntax_Syntax.Projector uu___4 -> true + | FStar_Syntax_Syntax.Discriminator uu___4 -> true + | FStar_Syntax_Syntax.Irreducible -> true + | uu___4 -> false) quals in + Prims.op_Negation uu___2 in + if will_encode_definition + then ([], env) + else + (let fv = + FStar_Syntax_Syntax.lid_as_fv lid + FStar_Pervasives_Native.None in + let uu___3 = + let uu___4 = + FStar_Compiler_Util.for_some is_uninterpreted_by_smt + se.FStar_Syntax_Syntax.sigattrs in + encode_top_level_val uu___4 env fv t quals in + match uu___3 with + | (decls, env1) -> + let tname = FStar_Ident.string_of_lid lid in + let tsym = + let uu___4 = + FStar_SMTEncoding_Env.try_lookup_free_var env1 lid in + FStar_Compiler_Option.get uu___4 in + let uu___4 = + let uu___5 = + let uu___6 = + primitive_type_axioms + env1.FStar_SMTEncoding_Env.tcenv lid tname tsym in + FStar_SMTEncoding_Term.mk_decls_trivial uu___6 in + FStar_Compiler_List.op_At decls uu___5 in + (uu___4, env1)) + | FStar_Syntax_Syntax.Sig_assume + { FStar_Syntax_Syntax.lid3 = l; FStar_Syntax_Syntax.us3 = us; + FStar_Syntax_Syntax.phi1 = f;_} + -> + let uu___1 = FStar_Syntax_Subst.open_univ_vars us f in + (match uu___1 with + | (uvs, f1) -> + let env1 = + let uu___2 = + FStar_TypeChecker_Env.push_univ_vars + env.FStar_SMTEncoding_Env.tcenv uvs in + { + FStar_SMTEncoding_Env.bvar_bindings = + (env.FStar_SMTEncoding_Env.bvar_bindings); + FStar_SMTEncoding_Env.fvar_bindings = + (env.FStar_SMTEncoding_Env.fvar_bindings); + FStar_SMTEncoding_Env.depth = + (env.FStar_SMTEncoding_Env.depth); + FStar_SMTEncoding_Env.tcenv = uu___2; + FStar_SMTEncoding_Env.warn = + (env.FStar_SMTEncoding_Env.warn); + FStar_SMTEncoding_Env.nolabels = + (env.FStar_SMTEncoding_Env.nolabels); + FStar_SMTEncoding_Env.use_zfuel_name = + (env.FStar_SMTEncoding_Env.use_zfuel_name); + FStar_SMTEncoding_Env.encode_non_total_function_typ = + (env.FStar_SMTEncoding_Env.encode_non_total_function_typ); + FStar_SMTEncoding_Env.current_module_name = + (env.FStar_SMTEncoding_Env.current_module_name); + FStar_SMTEncoding_Env.encoding_quantifier = + (env.FStar_SMTEncoding_Env.encoding_quantifier); + FStar_SMTEncoding_Env.global_cache = + (env.FStar_SMTEncoding_Env.global_cache) + } in + let f2 = norm_before_encoding env1 f1 in + let uu___2 = + FStar_SMTEncoding_EncodeTerm.encode_formula f2 env1 in + (match uu___2 with + | (f3, decls) -> + let g = + let uu___3 = + let uu___4 = + let uu___5 = + let uu___6 = + let uu___7 = + let uu___8 = + FStar_Syntax_Print.lid_to_string l in + FStar_Compiler_Util.format1 "Assumption: %s" + uu___8 in + FStar_Pervasives_Native.Some uu___7 in + let uu___7 = + let uu___8 = + let uu___9 = FStar_Ident.string_of_lid l in + Prims.strcat "assumption_" uu___9 in + FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.mk_unique + uu___8 in + (f3, uu___6, uu___7) in + FStar_SMTEncoding_Util.mkAssume uu___5 in + [uu___4] in + FStar_SMTEncoding_Term.mk_decls_trivial uu___3 in + ((FStar_Compiler_List.op_At decls g), env1))) + | FStar_Syntax_Syntax.Sig_let + { FStar_Syntax_Syntax.lbs1 = lbs; + FStar_Syntax_Syntax.lids1 = uu___1;_} + when + (FStar_Compiler_List.contains FStar_Syntax_Syntax.Irreducible + se.FStar_Syntax_Syntax.sigquals) + || + (FStar_Compiler_Util.for_some is_opaque_to_smt + se.FStar_Syntax_Syntax.sigattrs) + -> + let attrs = se.FStar_Syntax_Syntax.sigattrs in + let uu___2 = + FStar_Compiler_Util.fold_map + (fun env1 -> + fun lb -> + let lid = + let uu___3 = + let uu___4 = + FStar_Compiler_Util.right + lb.FStar_Syntax_Syntax.lbname in + uu___4.FStar_Syntax_Syntax.fv_name in + uu___3.FStar_Syntax_Syntax.v in + let uu___3 = + let uu___4 = + FStar_TypeChecker_Env.try_lookup_val_decl + env1.FStar_SMTEncoding_Env.tcenv lid in + FStar_Compiler_Option.isNone uu___4 in + if uu___3 + then + let val_decl = + { + FStar_Syntax_Syntax.sigel = + (FStar_Syntax_Syntax.Sig_declare_typ + { + FStar_Syntax_Syntax.lid2 = lid; + FStar_Syntax_Syntax.us2 = + (lb.FStar_Syntax_Syntax.lbunivs); + FStar_Syntax_Syntax.t2 = + (lb.FStar_Syntax_Syntax.lbtyp) + }); + FStar_Syntax_Syntax.sigrng = + (se.FStar_Syntax_Syntax.sigrng); + FStar_Syntax_Syntax.sigquals = + (FStar_Syntax_Syntax.Irreducible :: + (se.FStar_Syntax_Syntax.sigquals)); + FStar_Syntax_Syntax.sigmeta = + (se.FStar_Syntax_Syntax.sigmeta); + FStar_Syntax_Syntax.sigattrs = + (se.FStar_Syntax_Syntax.sigattrs); + FStar_Syntax_Syntax.sigopens_and_abbrevs = + (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); + FStar_Syntax_Syntax.sigopts = + (se.FStar_Syntax_Syntax.sigopts) + } in + let uu___4 = encode_sigelt' env1 val_decl in + match uu___4 with | (decls, env2) -> (env2, decls) + else (env1, [])) env (FStar_Pervasives_Native.snd lbs) in + (match uu___2 with + | (env1, decls) -> ((FStar_Compiler_List.flatten decls), env1)) + | FStar_Syntax_Syntax.Sig_let + { + FStar_Syntax_Syntax.lbs1 = + (uu___1, + { FStar_Syntax_Syntax.lbname = FStar_Pervasives.Inr b2t; + FStar_Syntax_Syntax.lbunivs = uu___2; + FStar_Syntax_Syntax.lbtyp = uu___3; + FStar_Syntax_Syntax.lbeff = uu___4; + FStar_Syntax_Syntax.lbdef = uu___5; + FStar_Syntax_Syntax.lbattrs = uu___6; + FStar_Syntax_Syntax.lbpos = uu___7;_}::[]); + FStar_Syntax_Syntax.lids1 = uu___8;_} + when FStar_Syntax_Syntax.fv_eq_lid b2t FStar_Parser_Const.b2t_lid + -> + let uu___9 = + FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid env + (b2t.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v + Prims.int_one in + (match uu___9 with + | (tname, ttok, env1) -> + let xx = + FStar_SMTEncoding_Term.mk_fv + ("x", FStar_SMTEncoding_Term.Term_sort) in + let x = FStar_SMTEncoding_Util.mkFreeV xx in + let b2t_x = FStar_SMTEncoding_Util.mkApp ("Prims.b2t", [x]) in + let valid_b2t_x = + FStar_SMTEncoding_Util.mkApp ("Valid", [b2t_x]) in + let bool_ty = + let uu___10 = + FStar_Syntax_Syntax.withsort FStar_Parser_Const.bool_lid in + FStar_SMTEncoding_Env.lookup_free_var env1 uu___10 in + let decls = + let uu___10 = + let uu___11 = + let uu___12 = + let uu___13 = + let uu___14 = FStar_Syntax_Syntax.range_of_fv b2t in + let uu___15 = + let uu___16 = + let uu___17 = + let uu___18 = + FStar_SMTEncoding_Util.mkApp + ((FStar_Pervasives_Native.snd + FStar_SMTEncoding_Term.boxBoolFun), + [x]) in + (valid_b2t_x, uu___18) in + FStar_SMTEncoding_Util.mkEq uu___17 in + ([[b2t_x]], [xx], uu___16) in + FStar_SMTEncoding_Term.mkForall uu___14 uu___15 in + (uu___13, (FStar_Pervasives_Native.Some "b2t def"), + "b2t_def") in + FStar_SMTEncoding_Util.mkAssume uu___12 in + let uu___12 = + let uu___13 = + let uu___14 = + let uu___15 = + let uu___16 = FStar_Syntax_Syntax.range_of_fv b2t in + let uu___17 = + let uu___18 = + let uu___19 = + let uu___20 = + FStar_SMTEncoding_Term.mk_HasType x + bool_ty in + let uu___21 = + FStar_SMTEncoding_Term.mk_HasType b2t_x + FStar_SMTEncoding_Term.mk_Term_type in + (uu___20, uu___21) in + FStar_SMTEncoding_Util.mkImp uu___19 in + ([[b2t_x]], [xx], uu___18) in + FStar_SMTEncoding_Term.mkForall uu___16 uu___17 in + (uu___15, + (FStar_Pervasives_Native.Some "b2t typing"), + "b2t_typing") in + FStar_SMTEncoding_Util.mkAssume uu___14 in + [uu___13] in + uu___11 :: uu___12 in + (FStar_SMTEncoding_Term.DeclFun + (tname, [FStar_SMTEncoding_Term.Term_sort], + FStar_SMTEncoding_Term.Term_sort, + FStar_Pervasives_Native.None)) + :: uu___10 in + let uu___10 = FStar_SMTEncoding_Term.mk_decls_trivial decls in + (uu___10, env1)) + | FStar_Syntax_Syntax.Sig_let uu___1 when + FStar_Compiler_Util.for_some + (fun uu___2 -> + match uu___2 with + | FStar_Syntax_Syntax.Discriminator uu___3 -> true + | uu___3 -> false) se.FStar_Syntax_Syntax.sigquals + -> + ((let uu___3 = + FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv + (FStar_Options.Other "SMTEncoding") in + if uu___3 + then + let uu___4 = FStar_Syntax_Print.sigelt_to_string_short se in + FStar_Compiler_Util.print1 "Not encoding discriminator '%s'\n" + uu___4 + else ()); + ([], env)) + | FStar_Syntax_Syntax.Sig_let + { FStar_Syntax_Syntax.lbs1 = uu___1; + FStar_Syntax_Syntax.lids1 = lids;_} + when + (FStar_Compiler_Util.for_some + (fun l -> + let uu___2 = + let uu___3 = + let uu___4 = FStar_Ident.ns_of_lid l in + FStar_Compiler_List.hd uu___4 in + FStar_Ident.string_of_id uu___3 in + uu___2 = "Prims") lids) + && + (FStar_Compiler_Util.for_some + (fun uu___2 -> + match uu___2 with + | FStar_Syntax_Syntax.Unfold_for_unification_and_vcgen -> + true + | uu___3 -> false) se.FStar_Syntax_Syntax.sigquals) + -> + ((let uu___3 = + FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv + (FStar_Options.Other "SMTEncoding") in + if uu___3 + then + let uu___4 = FStar_Syntax_Print.sigelt_to_string_short se in + FStar_Compiler_Util.print1 + "Not encoding unfold let from Prims '%s'\n" uu___4 + else ()); + ([], env)) + | FStar_Syntax_Syntax.Sig_let + { FStar_Syntax_Syntax.lbs1 = (false, lb::[]); + FStar_Syntax_Syntax.lids1 = uu___1;_} + when + FStar_Compiler_Util.for_some + (fun uu___2 -> + match uu___2 with + | FStar_Syntax_Syntax.Projector uu___3 -> true + | uu___3 -> false) se.FStar_Syntax_Syntax.sigquals + -> + let fv = FStar_Compiler_Util.right lb.FStar_Syntax_Syntax.lbname in + let l = (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + let uu___2 = FStar_SMTEncoding_Env.try_lookup_free_var env l in + (match uu___2 with + | FStar_Pervasives_Native.Some uu___3 -> ([], env) + | FStar_Pervasives_Native.None -> + let se1 = + let uu___3 = FStar_Ident.range_of_lid l in + { + FStar_Syntax_Syntax.sigel = + (FStar_Syntax_Syntax.Sig_declare_typ + { + FStar_Syntax_Syntax.lid2 = l; + FStar_Syntax_Syntax.us2 = + (lb.FStar_Syntax_Syntax.lbunivs); + FStar_Syntax_Syntax.t2 = + (lb.FStar_Syntax_Syntax.lbtyp) + }); + FStar_Syntax_Syntax.sigrng = uu___3; + FStar_Syntax_Syntax.sigquals = + (se.FStar_Syntax_Syntax.sigquals); + FStar_Syntax_Syntax.sigmeta = + (se.FStar_Syntax_Syntax.sigmeta); + FStar_Syntax_Syntax.sigattrs = + (se.FStar_Syntax_Syntax.sigattrs); + FStar_Syntax_Syntax.sigopens_and_abbrevs = + (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); + FStar_Syntax_Syntax.sigopts = + (se.FStar_Syntax_Syntax.sigopts) + } in + encode_sigelt env se1) + | FStar_Syntax_Syntax.Sig_let + { FStar_Syntax_Syntax.lbs1 = (is_rec, bindings); + FStar_Syntax_Syntax.lids1 = uu___1;_} + -> + let bindings1 = + FStar_Compiler_List.map + (fun lb -> + let def = + norm_before_encoding env lb.FStar_Syntax_Syntax.lbdef in + let typ = + norm_before_encoding env lb.FStar_Syntax_Syntax.lbtyp in + { + FStar_Syntax_Syntax.lbname = + (lb.FStar_Syntax_Syntax.lbname); + FStar_Syntax_Syntax.lbunivs = + (lb.FStar_Syntax_Syntax.lbunivs); + FStar_Syntax_Syntax.lbtyp = typ; + FStar_Syntax_Syntax.lbeff = + (lb.FStar_Syntax_Syntax.lbeff); + FStar_Syntax_Syntax.lbdef = def; + FStar_Syntax_Syntax.lbattrs = + (lb.FStar_Syntax_Syntax.lbattrs); + FStar_Syntax_Syntax.lbpos = + (lb.FStar_Syntax_Syntax.lbpos) + }) bindings in + encode_top_level_let env (is_rec, bindings1) + se.FStar_Syntax_Syntax.sigquals + | FStar_Syntax_Syntax.Sig_bundle + { FStar_Syntax_Syntax.ses = ses; + FStar_Syntax_Syntax.lids = uu___1;_} + -> + let tycon = + FStar_Compiler_List.tryFind + (fun se1 -> + FStar_Syntax_Syntax.uu___is_Sig_inductive_typ + se1.FStar_Syntax_Syntax.sigel) ses in + let is_injective_on_params = + match tycon with + | FStar_Pervasives_Native.None -> + FStar_Compiler_Effect.failwith + "Impossible: Sig_bundle without a Sig_inductive_typ" + | FStar_Pervasives_Native.Some se1 -> + is_sig_inductive_injective_on_params env se1 in + let uu___2 = + FStar_Compiler_List.fold_left + (fun uu___3 -> + fun se1 -> + match uu___3 with + | (g, env1) -> + let uu___4 = + match se1.FStar_Syntax_Syntax.sigel with + | FStar_Syntax_Syntax.Sig_inductive_typ uu___5 -> + encode_sig_inductive is_injective_on_params + env1 se1 + | FStar_Syntax_Syntax.Sig_datacon uu___5 -> + encode_datacon is_injective_on_params env1 se1 + | uu___5 -> encode_sigelt env1 se1 in + (match uu___4 with + | (g', env2) -> + ((FStar_Compiler_List.op_At g g'), env2))) + ([], env) ses in + (match uu___2 with + | (g, env1) -> + let uu___3 = + FStar_Compiler_List.fold_left + (fun uu___4 -> + fun elt -> + match uu___4 with + | (g', inversions) -> + let uu___5 = + FStar_Compiler_List.partition + (fun uu___6 -> + match uu___6 with + | FStar_SMTEncoding_Term.Assume + { + FStar_SMTEncoding_Term.assumption_term + = uu___7; + FStar_SMTEncoding_Term.assumption_caption + = FStar_Pervasives_Native.Some + "inversion axiom"; + FStar_SMTEncoding_Term.assumption_name + = uu___8; + FStar_SMTEncoding_Term.assumption_fact_ids + = uu___9;_} + -> false + | uu___7 -> true) + elt.FStar_SMTEncoding_Term.decls in + (match uu___5 with + | (elt_g', elt_inversions) -> + ((FStar_Compiler_List.op_At g' + [{ + FStar_SMTEncoding_Term.sym_name = + (elt.FStar_SMTEncoding_Term.sym_name); + FStar_SMTEncoding_Term.key = + (elt.FStar_SMTEncoding_Term.key); + FStar_SMTEncoding_Term.decls = + elt_g'; + FStar_SMTEncoding_Term.a_names = + (elt.FStar_SMTEncoding_Term.a_names) + }]), + (FStar_Compiler_List.op_At inversions + elt_inversions)))) ([], []) g in + (match uu___3 with + | (g', inversions) -> + let uu___4 = + FStar_Compiler_List.fold_left + (fun uu___5 -> + fun elt -> + match uu___5 with + | (decls, elts, rest) -> + let uu___6 = + (FStar_Compiler_Util.is_some + elt.FStar_SMTEncoding_Term.key) + && + (FStar_Compiler_List.existsb + (fun uu___7 -> + match uu___7 with + | FStar_SMTEncoding_Term.DeclFun + uu___8 -> true + | uu___8 -> false) + elt.FStar_SMTEncoding_Term.decls) in + if uu___6 + then + (decls, + (FStar_Compiler_List.op_At elts [elt]), + rest) + else + (let uu___8 = + FStar_Compiler_List.partition + (fun uu___9 -> + match uu___9 with + | FStar_SMTEncoding_Term.DeclFun + uu___10 -> true + | uu___10 -> false) + elt.FStar_SMTEncoding_Term.decls in + match uu___8 with + | (elt_decls, elt_rest) -> + ((FStar_Compiler_List.op_At decls + elt_decls), elts, + (FStar_Compiler_List.op_At rest + [{ + FStar_SMTEncoding_Term.sym_name + = + (elt.FStar_SMTEncoding_Term.sym_name); + FStar_SMTEncoding_Term.key = + (elt.FStar_SMTEncoding_Term.key); + FStar_SMTEncoding_Term.decls + = elt_rest; + FStar_SMTEncoding_Term.a_names + = + (elt.FStar_SMTEncoding_Term.a_names) + }])))) ([], [], []) g' in + (match uu___4 with + | (decls, elts, rest) -> + let uu___5 = + let uu___6 = + FStar_SMTEncoding_Term.mk_decls_trivial decls in + let uu___7 = + let uu___8 = + let uu___9 = + FStar_SMTEncoding_Term.mk_decls_trivial + inversions in + FStar_Compiler_List.op_At rest uu___9 in + FStar_Compiler_List.op_At elts uu___8 in + FStar_Compiler_List.op_At uu___6 uu___7 in + (uu___5, env1))))) let (encode_env_bindings : FStar_SMTEncoding_Env.env_t -> FStar_Syntax_Syntax.binding Prims.list -> diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index dc6e2598d7e..0f55936367d 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -1000,6 +1000,542 @@ let encode_top_level_let : [decl] |> mk_decls_trivial, env +let is_sig_inductive_injective_on_params (env:env_t) (se:sigelt) + : bool + = let Sig_inductive_typ { lid=t; us=universe_names; params=tps; t=k } = se.sigel in + let t_lid = t in + let tcenv = env.tcenv in + let usubst, uvs = SS.univ_var_opening universe_names in + let tcenv, tps, k = + Env.push_univ_vars tcenv uvs, + SS.subst_binders usubst tps, + SS.subst (SS.shift_subst (List.length tps) usubst) k + in + let tps, k = SS.open_term tps k in + let _, k = U.arrow_formals k in //don't care about indices here + let tps, env_tps, _, us = TcTerm.tc_binders tcenv tps in + let u_k = + TcTerm.level_of_type + env_tps + (S.mk_Tm_app + (S.fvar t None) + (snd (U.args_of_binders tps)) + (Ident.range_of_lid t)) + k + in + //BU.print2 "Universe of tycon: %s : %s\n" (Ident.string_of_lid t) (Print.univ_to_string u_k); + let rec universe_leq u v = + match u, v with + | U_zero, _ -> true + | U_succ u0, U_succ v0 -> universe_leq u0 v0 + | U_name u0, U_name v0 -> Ident.ident_equals u0 v0 + | U_name _, U_succ v0 -> universe_leq u v0 + | U_max us, _ -> us |> BU.for_all (fun u -> universe_leq u v) + | _, U_max vs -> vs |> BU.for_some (universe_leq u) + | U_unknown, _ + | _, U_unknown + | U_unif _, _ + | _, U_unif _ -> failwith (BU.format3 "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + (Ident.string_of_lid t) + (Print.univ_to_string u) + (Print.univ_to_string v)) + | _ -> false + in + let u_leq_u_k u = + let u = N.normalize_universe env_tps u in + universe_leq u u_k + in + let tp_ok (tp:S.binder) (u_tp:universe) = + let t_tp = tp.binder_bv.sort in + if u_leq_u_k u_tp + then true + else ( + let t_tp = + N.normalize + [Unrefine; Unascribe; Unmeta; + Primops; HNF; UnfoldUntil delta_constant; Beta] + env_tps t_tp + in + let formals, t = U.arrow_formals t_tp in + let _, _, _, u_formals = TcTerm.tc_binders env_tps formals in + let inj = BU.for_all (fun u_formal -> u_leq_u_k u_formal) u_formals in + if inj + then ( + match (SS.compress t).n with + | Tm_type u -> + (* retain injectivity for parameters that are type functions + from small universes (i.e., all formals are smaller than the constructed type) + to a universe <= the universe of the constructed type. + See BugBoxInjectivity.fst *) + u_leq_u_k u + | _ -> + false + ) + else ( + false + ) + + ) + in + let is_injective_on_params = List.forall2 tp_ok tps us in + if Env.debug env.tcenv <| Options.Other "SMTEncoding" + then BU.print2 "%s injectivity for %s\n" + (if is_injective_on_params then "YES" else "NO") + (Ident.string_of_lid t); + is_injective_on_params + + +let encode_sig_inductive (is_injective_on_params:bool) (env:env_t) (se:sigelt) +: decls_t * env_t += let Sig_inductive_typ { lid=t; us=universe_names; params=tps; t=k; ds=datas} = se.sigel in + let t_lid = t in + let tcenv = env.tcenv in + let quals = se.sigquals in + let is_logical = quals |> BU.for_some (function Logic | Assumption -> true | _ -> false) in + let constructor_or_logic_type_decl (c:constructor_t) = + if is_logical + then [Term.DeclFun(c.constr_name, c.constr_fields |> List.map (fun f -> f.field_sort), Term_sort, None)] + else constructor_to_decl (Ident.range_of_lid t) c in + let inversion_axioms env tapp vars = + if datas |> BU.for_some (fun l -> Env.try_lookup_lid env.tcenv l |> Option.isNone) //Q: Why would this happen? + then [] + else ( + let xxsym, xx = fresh_fvar env.current_module_name "x" Term_sort in + let data_ax, decls = + datas |> + List.fold_left + (fun (out, decls) l -> + let _, data_t = Env.lookup_datacon env.tcenv l in + let args, res = U.arrow_formals data_t in + let indices = res |> U.head_and_args_full |> snd in + let env = args |> List.fold_left + (fun env ({binder_bv=x}) -> push_term_var env x (mkApp(mk_term_projector_name l x, [xx]))) + env in + let indices, decls' = encode_args indices env in + if List.length indices <> List.length vars + then failwith "Impossible"; + let eqs = + if is_injective_on_params + || Options.ext_getv "compat:injectivity" <> "" + then List.map2 (fun v a -> mkEq(mkFreeV v, a)) vars indices + else ( + //only injectivity on indices + let num_params = List.length tps in + let _var_params, var_indices = List.splitAt num_params vars in + let _i_params, indices = List.splitAt num_params indices in + List.map2 (fun v a -> mkEq(mkFreeV v, a)) var_indices indices + ) + in + mkOr(out, mkAnd(mk_data_tester env l xx, eqs |> mk_and_l)), decls@decls') + (mkFalse, []) + in + let ffsym, ff = fresh_fvar env.current_module_name "f" Fuel_sort in + let fuel_guarded_inversion = + let xx_has_type_sfuel = + if List.length datas > 1 + then mk_HasTypeFuel (mkApp("SFuel", [ff])) xx tapp + else mk_HasTypeFuel ff xx tapp //no point requiring non-zero fuel if there are no disjunctions + in + Util.mkAssume( + mkForall + (Ident.range_of_lid t) + ([[xx_has_type_sfuel]], + add_fuel (mk_fv (ffsym, Fuel_sort)) (mk_fv (xxsym, Term_sort)::vars), + mkImp(xx_has_type_sfuel, data_ax)), + Some "inversion axiom", //this name matters! see Sig_bundle case near line 1493 + (varops.mk_unique ("fuel_guarded_inversion_"^(string_of_lid t)))) + in + decls + @([fuel_guarded_inversion] |> mk_decls_trivial) + ) + in + let formals, res = + let k = + match tps with + | [] -> k + | _ -> S.mk (Tm_arrow {bs=tps; comp=S.mk_Total k}) k.pos + in + let k = norm_before_encoding env k in + U.arrow_formals k + in + let vars, guards, env', binder_decls, _ = encode_binders None formals env in + let arity = List.length vars in + let tname, ttok, env = new_term_constant_and_tok_from_lid env t arity in + let ttok_tm = mkApp(ttok, []) in + let guard = mk_and_l guards in + let tapp = mkApp(tname, List.map mkFreeV vars) in //arity ok + let decls, env = + //See: https://github.com/FStarLang/FStar/commit/b75225bfbe427c8aef5b59f70ff6d79aa014f0b4 + //See: https://github.com/FStarLang/FStar/issues/349 + let tname_decl = + constructor_or_logic_type_decl + { + constr_name = tname; + constr_fields = vars |> List.map (fun fv -> {field_name=tname^fv_name fv; field_sort=fv_sort fv; field_projectible=false}) ; + //The field_projectible=false above is extremely important; it makes sure that type-formers are not injective + constr_sort=Term_sort; + constr_id=Some (varops.next_id()) + } + in + let tok_decls, env = + match vars with + | [] -> [], push_free_var env t arity tname (Some <| mkApp(tname, [])) + | _ -> + let ttok_decl = Term.DeclFun(ttok, [], Term_sort, Some "token") in + let ttok_fresh = Term.fresh_token (ttok, Term_sort) (varops.next_id()) in + let ttok_app = mk_Apply ttok_tm vars in + let pats = [[ttok_app]; [tapp]] in + // These patterns allow rewriting (ApplyT T@tok args) to (T args) and vice versa + // This seems necessary for some proofs, but the bidirectional rewriting may be inefficient + let name_tok_corr = + Util.mkAssume(mkForall' (Ident.range_of_lid t) (pats, None, vars, mkEq(ttok_app, tapp)), + Some "name-token correspondence", + ("token_correspondence_"^ttok)) in + [ttok_decl; ttok_fresh; name_tok_corr], env + in + tname_decl@tok_decls, env + in + let kindingAx = + let k, decls = encode_term_pred None res env' tapp in + let karr = + if List.length formals > 0 + then [Util.mkAssume(mk_tester "Tm_arrow" (mk_PreType ttok_tm), Some "kinding", ("pre_kinding_"^ttok))] + else [] + in + let rng = Ident.range_of_lid t in + let tot_fun_axioms = EncodeTerm.isTotFun_axioms rng ttok_tm vars (List.map (fun _ -> mkTrue) vars) true in + decls@(karr@[Util.mkAssume(mkAnd(tot_fun_axioms, mkForall rng ([[tapp]], vars, mkImp(guard, k))), + None, + ("kinding_"^ttok))] |> mk_decls_trivial) + in + let aux = + kindingAx + @(inversion_axioms env tapp vars) + @([pretype_axiom (Ident.range_of_lid t) env tapp vars] |> mk_decls_trivial) + in + (decls |> mk_decls_trivial)@binder_decls@aux, env + +let encode_datacon (is_injective_on_tparams:bool) (env:env_t) (se:sigelt) +: decls_t * env_t += let Sig_datacon {lid=d; t; num_ty_params=n_tps; mutuals} = se.sigel in + let quals = se.sigquals in + let t = norm_before_encoding env t in + let formals, t_res = U.arrow_formals t in + let arity = List.length formals in + let ddconstrsym, ddtok, env = new_term_constant_and_tok_from_lid env d arity in + let ddtok_tm = mkApp(ddtok, []) in + let fuel_var, fuel_tm = fresh_fvar env.current_module_name "f" Fuel_sort in + let s_fuel_tm = mkApp("SFuel", [fuel_tm]) in + let vars, guards, env', binder_decls, names = encode_binders (Some fuel_tm) formals env in + let fields = names |> List.mapi (fun n x -> + { field_name=mk_term_projector_name d x; + field_sort=Term_sort; + field_projectible=true }) + in + let datacons = + {constr_name=ddconstrsym; + constr_fields=fields; + constr_sort=Term_sort; + constr_id=Some (varops.next_id()) + } |> Term.constructor_to_decl (Ident.range_of_lid d) in + let app = mk_Apply ddtok_tm vars in + let guard = mk_and_l guards in + let xvars = List.map mkFreeV vars in + let dapp = mkApp(ddconstrsym, xvars) in //arity ok; |xvars| = |formals| = arity + + let tok_typing, decls3 = encode_term_pred None t env ddtok_tm in + let tok_typing = + match fields with + | _::_ -> + let ff = mk_fv ("ty", Term_sort) in + let f = mkFreeV ff in + let vtok_app_l = mk_Apply ddtok_tm [ff] in + let vtok_app_r = mk_Apply f [mk_fv (ddtok, Term_sort)] in + //guard the token typing assumption with a Apply(tok, f) or Apply(f, tok) + //Additionally, the body of the term becomes NoHoist f (HasType tok ...) + // to prevent the Z3 simplifier from hoisting the (HasType tok ...) part out + //Since the top-levels of modules are full of function typed terms + //not guarding it this way causes every typing assumption of an arrow type to be fired immediately + //regardless of whether or not the function is used ... leading to bloat + //these patterns aim to restrict the use of the typing assumption until such point as it is actually needed + mkForall (Ident.range_of_lid d) + ([[vtok_app_l]; [vtok_app_r]], + [ff], + Term.mk_NoHoist f tok_typing) + | _ -> tok_typing in + let ty_pred', t_res_tm, decls_pred = + let t_res_tm, t_res_decls = encode_term t_res env' in + mk_HasTypeWithFuel (Some fuel_tm) dapp t_res_tm, t_res_tm, t_res_decls in + let proxy_fresh = match formals with + | [] -> [] + | _ -> [Term.fresh_token (ddtok, Term_sort) (varops.next_id())] in + + let encode_elim () = + let head, args = U.head_and_args t_res in + match (SS.compress head).n with + | Tm_uinst({n=Tm_fvar fv}, _) + | Tm_fvar fv -> + let encoded_head_fvb = lookup_free_var_name env' fv.fv_name in + let encoded_args, arg_decls = encode_args args env' in + let guards_for_parameter (orig_arg:S.term)(arg:term) xv = + let fv = + match arg.tm with + | FreeV fv -> fv + | _ -> + Errors.raise_error (Errors.Fatal_NonVariableInductiveTypeParameter, + BU.format1 "Inductive type parameter %s must be a variable ; \ + You may want to change it to an index." + (FStar.Syntax.Print.term_to_string orig_arg)) orig_arg.pos + in + let guards = guards |> List.collect (fun g -> + if List.contains fv (Term.free_variables g) + then [Term.subst g fv xv] + else []) + in + mk_and_l guards + in + let _, arg_vars, elim_eqns_or_guards, _ = + List.fold_left + (fun (env, arg_vars, eqns_or_guards, i) (orig_arg, arg) -> + let _, xv, env = gen_term_var env (S.new_bv None tun) in + (* we only get equations induced on the type indices, not parameters; *) + (* Also see https://github.com/FStarLang/FStar/issues/349 *) + let eqns = + if i < n_tps + then guards_for_parameter (fst orig_arg) arg xv::eqns_or_guards + else mkEq(arg, xv)::eqns_or_guards + in + (env, xv::arg_vars, eqns, i + 1)) + (env', [], [], 0) + (FStar.Compiler.List.zip args encoded_args) + in + let arg_vars = List.rev arg_vars in + let ty = maybe_curry_fvb fv.fv_name.p encoded_head_fvb arg_vars in + let xvars = List.map mkFreeV vars in + let dapp = mkApp(ddconstrsym, xvars) in //arity ok; |xvars| = |formals| = arity + let ty_pred = mk_HasTypeWithFuel (Some s_fuel_tm) dapp ty in + let arg_binders = List.map fv_of_term arg_vars in + let typing_inversion = + Util.mkAssume(mkForall (Ident.range_of_lid d) ([[ty_pred]], + add_fuel (mk_fv (fuel_var, Fuel_sort)) (vars@arg_binders), + mkImp(ty_pred, mk_and_l (elim_eqns_or_guards@guards))), + Some "data constructor typing elim", + ("data_elim_" ^ ddconstrsym)) in + let lex_t = mkFreeV <| mk_fv (string_of_lid Const.lex_t_lid, Term_sort) in + let subterm_ordering = + (* subterm ordering *) + let prec = + vars + |> List.mapi (fun i v -> + (* it's a parameter, so it's inaccessible and no need for a sub-term ordering on it *) + if i < n_tps + then [] + else [mk_Precedes lex_t lex_t (mkFreeV v) dapp]) + |> List.flatten + in + Util.mkAssume(mkForall (Ident.range_of_lid d) + ([[ty_pred]], + add_fuel (mk_fv (fuel_var, Fuel_sort)) (vars@arg_binders), + mkImp(ty_pred, mk_and_l prec)), + Some "subterm ordering", + ("subterm_ordering_"^ddconstrsym)) + in + let codomain_ordering, codomain_decls = + let _, formals' = BU.first_N n_tps formals in (* no codomain ordering for the parameters *) + let _, vars' = BU.first_N n_tps vars in + let norm t = + N.unfold_whnf' [Env.AllowUnboundUniverses; + Env.EraseUniverses; + Env.Unascribe; + //we don't know if this will terminate; so don't do recursive steps + Env.Exclude Env.Zeta] + env'.tcenv + t + in + let warn_compat () = + FStar.Errors.log_issue + (S.range_of_fv fv) + (FStar.Errors.Warning_DeprecatedGeneric, + "Using 'compat:2954' to use a permissive encoding of the subterm ordering on the codomain of a constructor.\n\ + This is deprecated and will be removed in a future version of F*.") + in + let codomain_prec_l, cod_decls = + List.fold_left2 + (fun (codomain_prec_l, cod_decls) formal var -> + let rec binder_and_codomain_type t = + let t = U.unrefine t in + match (SS.compress t).n with + | Tm_arrow _ -> + let bs, c = U.arrow_formals_comp (U.unrefine t) in + begin + match bs with + | [] -> None + | _ when not (U.is_tot_or_gtot_comp c) -> None + | _ -> + if U.is_lemma_comp c + then None //not useful for lemmas + else + let t = U.unrefine (U.comp_result c) in + let t = norm t in + if is_type t || U.is_sub_singleton t + then None //ordering on Type and squashed values is not useful + else ( + let head, _ = U.head_and_args_full t in + match (U.un_uinst head).n with + | Tm_fvar fv -> + if BU.for_some (S.fv_eq_lid fv) mutuals + then Some (bs, c) + else if Options.ext_getv "compat:2954" <> "" + then (warn_compat(); Some (bs, c)) //compatibility mode + else None + | _ -> + if Options.ext_getv "compat:2954" <> "" + then (warn_compat(); Some (bs, c)) //compatibility mode + else None + ) + end + | _ -> + let head, _ = U.head_and_args t in + let t' = norm t in + let head', _ = U.head_and_args t' in + match U.eq_tm head head' with + | U.Equal -> None //no progress after whnf + | U.NotEqual -> binder_and_codomain_type t' + | _ -> + //Did we actually make progress? Be conservative to avoid an infinite loop + match (SS.compress head).n with + | Tm_fvar _ + | Tm_name _ + | Tm_uinst _ -> + //The underlying name must have changed, otherwise we would have got Equal + //so, we made some progress + binder_and_codomain_type t' + | _ -> + //unclear if we made progress or not + None + + in + match binder_and_codomain_type formal.binder_bv.sort with + | None -> + codomain_prec_l, cod_decls + | Some (bs, c) -> + //var bs << D ... var ... + let bs', guards', _env', bs_decls, _ = encode_binders None bs env' in + let fun_app = mk_Apply (mkFreeV var) bs' in + mkForall (Ident.range_of_lid d) + ([[mk_Precedes lex_t lex_t fun_app dapp]], + bs', + //need to use ty_pred' here, to avoid variable capture + //Note, ty_pred' is indexed by fuel, not S_fuel + //That's ok, since the outer pattern is guarded on S_fuel + mkImp (mk_and_l (ty_pred'::guards'), + mk_Precedes lex_t lex_t fun_app dapp)) + :: codomain_prec_l, + bs_decls @ cod_decls) + ([],[]) + formals' + vars' + in + match codomain_prec_l with + | [] -> + [], cod_decls + | _ -> + [Util.mkAssume(mkForall (Ident.range_of_lid d) + ([[ty_pred]],//we use ty_pred here as the pattern, which has an S_fuel guard + add_fuel (mk_fv (fuel_var, Fuel_sort)) (vars@arg_binders), + mk_and_l codomain_prec_l), + Some "well-founded ordering on codomain", + ("well_founded_ordering_on_codomain_"^ddconstrsym))], + cod_decls + in + arg_decls @ codomain_decls, + [typing_inversion; subterm_ordering] @ codomain_ordering + + | _ -> + Errors.log_issue se.sigrng + (Errors.Warning_ConstructorBuildsUnexpectedType, + BU.format2 "Constructor %s builds an unexpected type %s\n" + (Print.lid_to_string d) (Print.term_to_string head)); + [], [] + in + let decls2, elim = encode_elim () in + let data_cons_typing_intro_decl = + // + //AR: + // + //Typing intro for the data constructor + // + //We do a bit of manipulation for type indices + //Consider the Cons data constructor of a length-indexed vector type: + // type vector : nat -> Type = | Emp : vector 0 + // | Cons: n:nat -> hd:nat -> tl:vec n -> vec (n+1) + // + //So far we have + // ty_pred' = HasTypeFuel f (Cons n hd tl) (vector (n+1)) + // vars = n, hd, tl + // guard = And of typing guards for n, hd, tl (i.e. (HasType n nat) etc.) + // + //If we emitted the straightforward typing axiom: + // forall n hd tl. HasTypeFuel f (Cons n hd tl) (vector (n+1)) + //with pattern + // HasTypeFuel f (Cons n hd tl) (vecor (n+1)) + // + //It results in too restrictive a pattern, + //Specifically, if we need to prove HasTypeFuel f (Cons 0 1 Emp) (vector 1), + // the axiom will not fire, since the pattern is specifically looking for + // (n+1) in the resulting vector type, whereas here we have a term 1, + // which is not addition syntactically + // + //So we do a little bit of surgery below to emit an axiom of the form: + // forall n hd tl m. m = n + 1 ==> HasTypeFuel f (Cons n hd tl) (vector m) + //where m is a fresh variable + // + //Also see #2456 + // + let ty_pred', vars, guard = + match t_res_tm.tm with + | App (op, args) -> + //iargs are index arguments in the return type of the data constructor + let targs, iargs = List.splitAt n_tps args in + //fresh vars for iargs + let fresh_ivars, fresh_iargs = + iargs |> List.map (fun _ -> fresh_fvar env.current_module_name "i" Term_sort) + |> List.split in + //equality guards + let additional_guards = + mk_and_l (List.map2 (fun a fresh_a -> mkEq (a, fresh_a)) iargs fresh_iargs) in + + mk_HasTypeWithFuel + (Some fuel_tm) + dapp + ({t_res_tm with tm = App (op, targs@fresh_iargs)}), + + vars@(fresh_ivars |> List.map (fun s -> mk_fv (s, Term_sort))), + + mkAnd (guard, additional_guards) + + | _ -> ty_pred', vars, guard in //When will this case arise? + + Util.mkAssume(mkForall (Ident.range_of_lid d) + ([[ty_pred']],add_fuel (mk_fv (fuel_var, Fuel_sort)) vars, mkImp(guard, ty_pred')), + Some "data constructor typing intro", + ("data_typing_intro_"^ddtok)) in + + let g = binder_decls + @decls2 + @decls3 + @([Term.DeclFun(ddtok, [], Term_sort, Some (BU.format1 "data constructor proxy: %s" (Print.lid_to_string d)))] + @proxy_fresh |> mk_decls_trivial) + @decls_pred + @([Util.mkAssume(tok_typing, Some "typing for data constructor proxy", ("typing_tok_"^ddtok)); + Util.mkAssume(mkForall (Ident.range_of_lid d) + ([[app]], vars, + mkEq(app, dapp)), Some "equality for proxy", ("equality_tok_"^ddtok)); + data_cons_typing_intro_decl; + ]@elim |> mk_decls_trivial) in + (datacons |> mk_decls_trivial) @ g, env + + let rec encode_sigelt (env:env_t) (se:sigelt) : (decls_t * env_t) = let nm = Print.sigelt_to_string_short se in let g, env = Errors.with_ctx (BU.format1 "While encoding top-level declaration `%s`" @@ -1214,549 +1750,69 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = encode_top_level_let env (is_rec, bindings) se.sigquals | Sig_bundle {ses} -> - let g, env = encode_sigelts env ses in - let g', inversions = List.fold_left (fun (g', inversions) elt -> - let elt_g', elt_inversions = elt.decls |> List.partition (function - | Term.Assume({assumption_caption=Some "inversion axiom"}) -> false - | _ -> true) in - g' @ [ { elt with decls = elt_g' } ], inversions @ elt_inversions - ) ([], []) g in - let decls, elts, rest = List.fold_left (fun (decls, elts, rest) elt -> - if elt.key |> BU.is_some && List.existsb (function | Term.DeclFun _ -> true | _ -> false) elt.decls - then decls, elts@[elt], rest - else let elt_decls, elt_rest = elt.decls |> List.partition (function - | Term.DeclFun _ -> true - | _ -> false) in - decls @ elt_decls, elts, rest @ [ { elt with decls = elt_rest }] - ) ([], [], []) g' in - (decls |> mk_decls_trivial) @ elts @ rest @ (inversions |> mk_decls_trivial), env - - | Sig_inductive_typ {lid=t; - us=universe_names; - params=tps; - t=k; - ds=datas} -> - let t_lid = t in - let tcenv = env.tcenv in - let is_injective_on_params = - let usubst, uvs = SS.univ_var_opening universe_names in - let env, tps, k = - Env.push_univ_vars tcenv uvs, - SS.subst_binders usubst tps, - SS.subst (SS.shift_subst (List.length tps) usubst) k - in - let tps, k = SS.open_term tps k in - let _, k = U.arrow_formals k in //don't care about indices here - let tps, env_tps, _, us = TcTerm.tc_binders env tps in - let u_k = - TcTerm.level_of_type - env_tps - (S.mk_Tm_app - (S.fvar t None) - (snd (U.args_of_binders tps)) - (Ident.range_of_lid t)) - k - in - //BU.print2 "Universe of tycon: %s : %s\n" (Ident.string_of_lid t) (Print.univ_to_string u_k); - let rec universe_leq u v = - match u, v with - | U_zero, _ -> true - | U_succ u0, U_succ v0 -> universe_leq u0 v0 - | U_name u0, U_name v0 -> Ident.ident_equals u0 v0 - | U_name _, U_succ v0 -> universe_leq u v0 - | U_max us, _ -> us |> BU.for_all (fun u -> universe_leq u v) - | _, U_max vs -> vs |> BU.for_some (universe_leq u) - | U_unknown, _ - | _, U_unknown - | U_unif _, _ - | _, U_unif _ -> failwith (BU.format3 "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - (Ident.string_of_lid t) - (Print.univ_to_string u) - (Print.univ_to_string v)) - | _ -> false - in - let u_leq_u_k u = - let u = N.normalize_universe env_tps u in - universe_leq u u_k - in - let tp_ok (tp:S.binder) (u_tp:universe) = - let t_tp = tp.binder_bv.sort in - if u_leq_u_k u_tp - then true - else ( - let t_tp = - N.normalize - [Unrefine; Unascribe; Unmeta; - Primops; HNF; UnfoldUntil delta_constant; Beta] - env_tps t_tp - in - let formals, t = U.arrow_formals t_tp in - let _, _, _, u_formals = TcTerm.tc_binders env_tps formals in - let inj = BU.for_all (fun u_formal -> u_leq_u_k u_formal) u_formals in - if inj - then ( - match (SS.compress t).n with - | Tm_type u -> - (* retain injectivity for parameters that are type functions - from small universes (i.e., all formals are smaller than the constructed type) - to a universe <= the universe of the constructed type. - See BugBoxInjectivity.fst *) - u_leq_u_k u - // | Tm_name _ -> (* this is a value of another type parameter in scope *) - // true - | _ -> - false - ) - else ( - false - ) - - ) - in - List.forall2 tp_ok tps us - in - if Env.debug env.tcenv <| Options.Other "SMTEncoding" - then BU.print2 "%s injectivity for %s\n" - (if is_injective_on_params then "YES" else "NO") - (Ident.string_of_lid t); - let quals = se.sigquals in - let is_logical = quals |> BU.for_some (function Logic | Assumption -> true | _ -> false) in - let constructor_or_logic_type_decl (c:constructor_t) = - if is_logical - then [Term.DeclFun(c.constr_name, c.constr_fields |> List.map (fun f -> f.field_sort), Term_sort, None)] - else constructor_to_decl (Ident.range_of_lid t) c in - let inversion_axioms env tapp vars = - if datas |> BU.for_some (fun l -> Env.try_lookup_lid env.tcenv l |> Option.isNone) //Q: Why would this happen? - then [] - else - let xxsym, xx = fresh_fvar env.current_module_name "x" Term_sort in - let data_ax, decls = datas |> List.fold_left (fun (out, decls) l -> - let _, data_t = Env.lookup_datacon env.tcenv l in - let args, res = U.arrow_formals data_t in - let indices = res |> U.head_and_args_full |> snd in - let env = args |> List.fold_left - (fun env ({binder_bv=x}) -> push_term_var env x (mkApp(mk_term_projector_name l x, [xx]))) - env in - let indices, decls' = encode_args indices env in - if List.length indices <> List.length vars - then failwith "Impossible"; - let eqs = - if is_injective_on_params - || Options.ext_getv "compat:injectivity" <> "" - then List.map2 (fun v a -> mkEq(mkFreeV v, a)) vars indices - else ( - //only injectivity on indices - let num_params = List.length tps in - let _var_params, var_indices = List.splitAt num_params vars in - let _i_params, indices = List.splitAt num_params indices in - List.map2 (fun v a -> mkEq(mkFreeV v, a)) var_indices indices - ) - in - mkOr(out, mkAnd(mk_data_tester env l xx, eqs |> mk_and_l)), decls@decls') (mkFalse, []) in - let ffsym, ff = fresh_fvar env.current_module_name "f" Fuel_sort in - let fuel_guarded_inversion = - let xx_has_type_sfuel = - if List.length datas > 1 - then mk_HasTypeFuel (mkApp("SFuel", [ff])) xx tapp - else mk_HasTypeFuel ff xx tapp in //no point requiring non-zero fuel if there are no disjunctions - Util.mkAssume(mkForall (Ident.range_of_lid t) ([[xx_has_type_sfuel]], add_fuel (mk_fv (ffsym, Fuel_sort)) (mk_fv (xxsym, Term_sort)::vars), - mkImp(xx_has_type_sfuel, data_ax)), - Some "inversion axiom", //this name matters! see Sig_bundle case near line 1493 - (varops.mk_unique ("fuel_guarded_inversion_"^(string_of_lid t)))) in - decls - @([fuel_guarded_inversion] |> mk_decls_trivial) in - - let formals, res = - let k = - match tps with - | [] -> k - | _ -> S.mk (Tm_arrow {bs=tps; comp=S.mk_Total k}) k.pos - in - let k = norm_before_encoding env k in - U.arrow_formals k - in - - let vars, guards, env', binder_decls, _ = encode_binders None formals env in - let arity = List.length vars in - let tname, ttok, env = new_term_constant_and_tok_from_lid env t arity in - let ttok_tm = mkApp(ttok, []) in - let guard = mk_and_l guards in - let tapp = mkApp(tname, List.map mkFreeV vars) in //arity ok - let decls, env = - //See: https://github.com/FStarLang/FStar/commit/b75225bfbe427c8aef5b59f70ff6d79aa014f0b4 - //See: https://github.com/FStarLang/FStar/issues/349 - let tname_decl = - constructor_or_logic_type_decl - { - constr_name = tname; - constr_fields = vars |> List.map (fun fv -> {field_name=tname^fv_name fv; field_sort=fv_sort fv; field_projectible=false}) ; - //The field_projectible=false above is extremely important; it makes sure that type-formers are not injective - constr_sort=Term_sort; - constr_id=Some (varops.next_id()) - } - in - let tok_decls, env = - match vars with - | [] -> [], push_free_var env t arity tname (Some <| mkApp(tname, [])) - | _ -> - let ttok_decl = Term.DeclFun(ttok, [], Term_sort, Some "token") in - let ttok_fresh = Term.fresh_token (ttok, Term_sort) (varops.next_id()) in - let ttok_app = mk_Apply ttok_tm vars in - let pats = [[ttok_app]; [tapp]] in - // These patterns allow rewriting (ApplyT T@tok args) to (T args) and vice versa - // This seems necessary for some proofs, but the bidirectional rewriting may be inefficient - let name_tok_corr = Util.mkAssume(mkForall' (Ident.range_of_lid t) (pats, None, vars, mkEq(ttok_app, tapp)), - Some "name-token correspondence", - ("token_correspondence_"^ttok)) in - [ttok_decl; ttok_fresh; name_tok_corr], env in - tname_decl@tok_decls, env in - let kindingAx = - let k, decls = encode_term_pred None res env' tapp in - let karr = - if List.length formals > 0 - then [Util.mkAssume(mk_tester "Tm_arrow" (mk_PreType ttok_tm), Some "kinding", ("pre_kinding_"^ttok))] - else [] - in - let rng = Ident.range_of_lid t in - let tot_fun_axioms = - EncodeTerm.isTotFun_axioms rng ttok_tm vars (List.map (fun _ -> mkTrue) vars) true + let tycon = List.tryFind (fun se -> Sig_inductive_typ? se.sigel) ses in + let is_injective_on_params = + match tycon with + | None -> failwith "Impossible: Sig_bundle without a Sig_inductive_typ" + | Some se -> + is_sig_inductive_injective_on_params env se + in + let g, env = + ses |> + List.fold_left + (fun (g, env) se -> + let g', env = + match se.sigel with + | Sig_inductive_typ _ -> + encode_sig_inductive is_injective_on_params env se + | Sig_datacon _ -> + encode_datacon is_injective_on_params env se + | _ -> + encode_sigelt env se in - - decls@(karr@[Util.mkAssume(mkAnd(tot_fun_axioms, mkForall rng ([[tapp]], vars, mkImp(guard, k))), None, ("kinding_"^ttok))] - |> mk_decls_trivial) in - let aux = - kindingAx - @(inversion_axioms env tapp vars) - @([pretype_axiom (Ident.range_of_lid t) env tapp vars] |> mk_decls_trivial) in - - let g = (decls |> mk_decls_trivial) - @binder_decls - @aux in - g, env - - | Sig_datacon {lid=d; t; num_ty_params=n_tps; mutuals} -> - let quals = se.sigquals in - let t = norm_before_encoding env t in - let formals, t_res = U.arrow_formals t in - let arity = List.length formals in - let ddconstrsym, ddtok, env = new_term_constant_and_tok_from_lid env d arity in - let ddtok_tm = mkApp(ddtok, []) in - let fuel_var, fuel_tm = fresh_fvar env.current_module_name "f" Fuel_sort in - let s_fuel_tm = mkApp("SFuel", [fuel_tm]) in - let vars, guards, env', binder_decls, names = encode_binders (Some fuel_tm) formals env in - let fields = names |> List.mapi (fun n x -> - { field_name=mk_term_projector_name d x; - field_sort=Term_sort; - field_projectible=true }) - in - let datacons = - {constr_name=ddconstrsym; - constr_fields=fields; - constr_sort=Term_sort; - constr_id=Some (varops.next_id()) - } |> Term.constructor_to_decl (Ident.range_of_lid d) in - let app = mk_Apply ddtok_tm vars in - let guard = mk_and_l guards in - let xvars = List.map mkFreeV vars in - let dapp = mkApp(ddconstrsym, xvars) in //arity ok; |xvars| = |formals| = arity - - let tok_typing, decls3 = encode_term_pred None t env ddtok_tm in - let tok_typing = - match fields with - | _::_ -> - let ff = mk_fv ("ty", Term_sort) in - let f = mkFreeV ff in - let vtok_app_l = mk_Apply ddtok_tm [ff] in - let vtok_app_r = mk_Apply f [mk_fv (ddtok, Term_sort)] in - //guard the token typing assumption with a Apply(tok, f) or Apply(f, tok) - //Additionally, the body of the term becomes NoHoist f (HasType tok ...) - // to prevent the Z3 simplifier from hoisting the (HasType tok ...) part out - //Since the top-levels of modules are full of function typed terms - //not guarding it this way causes every typing assumption of an arrow type to be fired immediately - //regardless of whether or not the function is used ... leading to bloat - //these patterns aim to restrict the use of the typing assumption until such point as it is actually needed - mkForall (Ident.range_of_lid d) - ([[vtok_app_l]; [vtok_app_r]], - [ff], - Term.mk_NoHoist f tok_typing) - | _ -> tok_typing in - let ty_pred', t_res_tm, decls_pred = - let t_res_tm, t_res_decls = encode_term t_res env' in - mk_HasTypeWithFuel (Some fuel_tm) dapp t_res_tm, t_res_tm, t_res_decls in - let proxy_fresh = match formals with - | [] -> [] - | _ -> [Term.fresh_token (ddtok, Term_sort) (varops.next_id())] in - - let encode_elim () = - let head, args = U.head_and_args t_res in - match (SS.compress head).n with - | Tm_uinst({n=Tm_fvar fv}, _) - | Tm_fvar fv -> - let encoded_head_fvb = lookup_free_var_name env' fv.fv_name in - let encoded_args, arg_decls = encode_args args env' in - let guards_for_parameter (orig_arg:S.term)(arg:term) xv = - let fv = - match arg.tm with - | FreeV fv -> fv - | _ -> - Errors.raise_error (Errors.Fatal_NonVariableInductiveTypeParameter, - BU.format1 "Inductive type parameter %s must be a variable ; \ - You may want to change it to an index." - (FStar.Syntax.Print.term_to_string orig_arg)) orig_arg.pos - in - let guards = guards |> List.collect (fun g -> - if List.contains fv (Term.free_variables g) - then [Term.subst g fv xv] - else []) - in - mk_and_l guards - in - let _, arg_vars, elim_eqns_or_guards, _ = - List.fold_left - (fun (env, arg_vars, eqns_or_guards, i) (orig_arg, arg) -> - let _, xv, env = gen_term_var env (S.new_bv None tun) in - (* we only get equations induced on the type indices, not parameters; *) - (* Also see https://github.com/FStarLang/FStar/issues/349 *) - let eqns = - if i < n_tps - then guards_for_parameter (fst orig_arg) arg xv::eqns_or_guards - else mkEq(arg, xv)::eqns_or_guards - in - (env, xv::arg_vars, eqns, i + 1)) - (env', [], [], 0) - (FStar.Compiler.List.zip args encoded_args) + g@g', env) + ([], env) + in + //reorder the generated decls in proper def-use order, + //i.e, declare all the function symbols first + //1. move the inversions last; they rely on all the symbols + let g', inversions = + List.fold_left + (fun (g', inversions) elt -> + let elt_g', elt_inversions = + elt.decls |> + List.partition + (function + | Term.Assume({assumption_caption=Some "inversion axiom"}) -> false + | _ -> true) in - let arg_vars = List.rev arg_vars in - let ty = maybe_curry_fvb fv.fv_name.p encoded_head_fvb arg_vars in - let xvars = List.map mkFreeV vars in - let dapp = mkApp(ddconstrsym, xvars) in //arity ok; |xvars| = |formals| = arity - let ty_pred = mk_HasTypeWithFuel (Some s_fuel_tm) dapp ty in - let arg_binders = List.map fv_of_term arg_vars in - let typing_inversion = - Util.mkAssume(mkForall (Ident.range_of_lid d) ([[ty_pred]], - add_fuel (mk_fv (fuel_var, Fuel_sort)) (vars@arg_binders), - mkImp(ty_pred, mk_and_l (elim_eqns_or_guards@guards))), - Some "data constructor typing elim", - ("data_elim_" ^ ddconstrsym)) in - let lex_t = mkFreeV <| mk_fv (string_of_lid Const.lex_t_lid, Term_sort) in - let subterm_ordering = - (* subterm ordering *) - let prec = - vars - |> List.mapi (fun i v -> - (* it's a parameter, so it's inaccessible and no need for a sub-term ordering on it *) - if i < n_tps - then [] - else [mk_Precedes lex_t lex_t (mkFreeV v) dapp]) - |> List.flatten - in - Util.mkAssume(mkForall (Ident.range_of_lid d) - ([[ty_pred]], - add_fuel (mk_fv (fuel_var, Fuel_sort)) (vars@arg_binders), - mkImp(ty_pred, mk_and_l prec)), - Some "subterm ordering", - ("subterm_ordering_"^ddconstrsym)) - in - let codomain_ordering, codomain_decls = - let _, formals' = BU.first_N n_tps formals in (* no codomain ordering for the parameters *) - let _, vars' = BU.first_N n_tps vars in - let norm t = - N.unfold_whnf' [Env.AllowUnboundUniverses; - Env.EraseUniverses; - Env.Unascribe; - //we don't know if this will terminate; so don't do recursive steps - Env.Exclude Env.Zeta] - env'.tcenv - t - in - let warn_compat () = - FStar.Errors.log_issue - (S.range_of_fv fv) - (FStar.Errors.Warning_DeprecatedGeneric, - "Using 'compat:2954' to use a permissive encoding of the subterm ordering on the codomain of a constructor.\n\ - This is deprecated and will be removed in a future version of F*.") - in - let codomain_prec_l, cod_decls = - List.fold_left2 - (fun (codomain_prec_l, cod_decls) formal var -> - let rec binder_and_codomain_type t = - let t = U.unrefine t in - match (SS.compress t).n with - | Tm_arrow _ -> - let bs, c = U.arrow_formals_comp (U.unrefine t) in - begin - match bs with - | [] -> None - | _ when not (U.is_tot_or_gtot_comp c) -> None - | _ -> - if U.is_lemma_comp c - then None //not useful for lemmas - else - let t = U.unrefine (U.comp_result c) in - let t = norm t in - if is_type t || U.is_sub_singleton t - then None //ordering on Type and squashed values is not useful - else ( - let head, _ = U.head_and_args_full t in - match (U.un_uinst head).n with - | Tm_fvar fv -> - if BU.for_some (S.fv_eq_lid fv) mutuals - then Some (bs, c) - else if Options.ext_getv "compat:2954" <> "" - then (warn_compat(); Some (bs, c)) //compatibility mode - else None - | _ -> - if Options.ext_getv "compat:2954" <> "" - then (warn_compat(); Some (bs, c)) //compatibility mode - else None - ) - end - | _ -> - let head, _ = U.head_and_args t in - let t' = norm t in - let head', _ = U.head_and_args t' in - match U.eq_tm head head' with - | U.Equal -> None //no progress after whnf - | U.NotEqual -> binder_and_codomain_type t' - | _ -> - //Did we actually make progress? Be conservative to avoid an infinite loop - match (SS.compress head).n with - | Tm_fvar _ - | Tm_name _ - | Tm_uinst _ -> - //The underlying name must have changed, otherwise we would have got Equal - //so, we made some progress - binder_and_codomain_type t' - | _ -> - //unclear if we made progress or not - None - - in - match binder_and_codomain_type formal.binder_bv.sort with - | None -> - codomain_prec_l, cod_decls - | Some (bs, c) -> - //var bs << D ... var ... - let bs', guards', _env', bs_decls, _ = encode_binders None bs env' in - let fun_app = mk_Apply (mkFreeV var) bs' in - mkForall (Ident.range_of_lid d) - ([[mk_Precedes lex_t lex_t fun_app dapp]], - bs', - //need to use ty_pred' here, to avoid variable capture - //Note, ty_pred' is indexed by fuel, not S_fuel - //That's ok, since the outer pattern is guarded on S_fuel - mkImp (mk_and_l (ty_pred'::guards'), - mk_Precedes lex_t lex_t fun_app dapp)) - :: codomain_prec_l, - bs_decls @ cod_decls) - ([],[]) - formals' - vars' - in - match codomain_prec_l with - | [] -> - [], cod_decls - | _ -> - [Util.mkAssume(mkForall (Ident.range_of_lid d) - ([[ty_pred]],//we use ty_pred here as the pattern, which has an S_fuel guard - add_fuel (mk_fv (fuel_var, Fuel_sort)) (vars@arg_binders), - mk_and_l codomain_prec_l), - Some "well-founded ordering on codomain", - ("well_founded_ordering_on_codomain_"^ddconstrsym))], - cod_decls + g' @ [ { elt with decls = elt_g' } ], + inversions @ elt_inversions) + ([], []) + g + in + //2. decls are all the function symbol declarations + // elts: not sure what this represents + // rest: all the non-declarations, excepting the inversion axiom which is already identified above + let decls, elts, rest = + List.fold_left + (fun (decls, elts, rest) elt -> + if BU.is_some elt.key //NS: Not sure what this case is for + && List.existsb (function | Term.DeclFun _ -> true | _ -> false) elt.decls + then decls, elts@[elt], rest + else ( //Pull the function symbol decls to the front + let elt_decls, elt_rest = + elt.decls |> + List.partition + (function + | Term.DeclFun _ -> true + | _ -> false) in - arg_decls @ codomain_decls, - [typing_inversion; subterm_ordering] @ codomain_ordering - - | _ -> - Errors.log_issue se.sigrng - (Errors.Warning_ConstructorBuildsUnexpectedType, - BU.format2 "Constructor %s builds an unexpected type %s\n" - (Print.lid_to_string d) (Print.term_to_string head)); - [], [] - in - let decls2, elim = encode_elim () in - let data_cons_typing_intro_decl = - // - //AR: - // - //Typing intro for the data constructor - // - //We do a bit of manipulation for type indices - //Consider the Cons data constructor of a length-indexed vector type: - // type vector : nat -> Type = | Emp : vector 0 - // | Cons: n:nat -> hd:nat -> tl:vec n -> vec (n+1) - // - //So far we have - // ty_pred' = HasTypeFuel f (Cons n hd tl) (vector (n+1)) - // vars = n, hd, tl - // guard = And of typing guards for n, hd, tl (i.e. (HasType n nat) etc.) - // - //If we emitted the straightforward typing axiom: - // forall n hd tl. HasTypeFuel f (Cons n hd tl) (vector (n+1)) - //with pattern - // HasTypeFuel f (Cons n hd tl) (vecor (n+1)) - // - //It results in too restrictive a pattern, - //Specifically, if we need to prove HasTypeFuel f (Cons 0 1 Emp) (vector 1), - // the axiom will not fire, since the pattern is specifically looking for - // (n+1) in the resulting vector type, whereas here we have a term 1, - // which is not addition syntactically - // - //So we do a little bit of surgery below to emit an axiom of the form: - // forall n hd tl m. m = n + 1 ==> HasTypeFuel f (Cons n hd tl) (vector m) - //where m is a fresh variable - // - //Also see #2456 - // - let ty_pred', vars, guard = - match t_res_tm.tm with - | App (op, args) -> - //iargs are index arguments in the return type of the data constructor - let targs, iargs = List.splitAt n_tps args in - //fresh vars for iargs - let fresh_ivars, fresh_iargs = - iargs |> List.map (fun _ -> fresh_fvar env.current_module_name "i" Term_sort) - |> List.split in - //equality guards - let additional_guards = - mk_and_l (List.map2 (fun a fresh_a -> mkEq (a, fresh_a)) iargs fresh_iargs) in - - mk_HasTypeWithFuel - (Some fuel_tm) - dapp - ({t_res_tm with tm = App (op, targs@fresh_iargs)}), - - vars@(fresh_ivars |> List.map (fun s -> mk_fv (s, Term_sort))), - - mkAnd (guard, additional_guards) - - | _ -> ty_pred', vars, guard in //When will this case arise? - - Util.mkAssume(mkForall (Ident.range_of_lid d) - ([[ty_pred']],add_fuel (mk_fv (fuel_var, Fuel_sort)) vars, mkImp(guard, ty_pred')), - Some "data constructor typing intro", - ("data_typing_intro_"^ddtok)) in - - let g = binder_decls - @decls2 - @decls3 - @([Term.DeclFun(ddtok, [], Term_sort, Some (BU.format1 "data constructor proxy: %s" (Print.lid_to_string d)))] - @proxy_fresh |> mk_decls_trivial) - @decls_pred - @([Util.mkAssume(tok_typing, Some "typing for data constructor proxy", ("typing_tok_"^ddtok)); - Util.mkAssume(mkForall (Ident.range_of_lid d) - ([[app]], vars, - mkEq(app, dapp)), Some "equality for proxy", ("equality_tok_"^ddtok)); - data_cons_typing_intro_decl; - ]@elim |> mk_decls_trivial) in - (datacons |> mk_decls_trivial) @ g, env - -and encode_sigelts env ses :(decls_t * env_t) = - ses |> List.fold_left (fun (g, env) se -> - let g', env = encode_sigelt env se in - g@g', env) ([], env) - + decls @ elt_decls, elts, rest @ [ { elt with decls = elt_rest }] + )) + ([], [], []) g' + in + (decls |> mk_decls_trivial) @ elts @ rest @ (inversions |> mk_decls_trivial), env let encode_env_bindings (env:env_t) (bindings:list S.binding) : (decls_t * env_t) = (* Encoding Binding_var and Binding_typ as local constants leads to breakages in hash consing. From 448857d6cf50fa9083ae2f04dd68687131d3e434 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Fri, 19 Apr 2024 11:56:12 -0700 Subject: [PATCH 034/239] restrict injectivity for data constructor type parameters --- .../generated/FStar_SMTEncoding_Encode.ml | 9 +++-- src/smtencoding/FStar.SMTEncoding.Encode.fst | 19 ++++++--- tests/bug-reports/BugBoxInjectivity.fst | 39 +++++-------------- 3 files changed, 28 insertions(+), 39 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index 5fa3195d52e..18fcd51d3de 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -4510,6 +4510,9 @@ let (encode_datacon : FStar_Compiler_List.mapi (fun n -> fun x -> + let field_projectible = + (n >= n_tps) || + is_injective_on_tparams in let uu___7 = FStar_SMTEncoding_Env.mk_term_projector_name d x in @@ -4520,7 +4523,7 @@ let (encode_datacon : = FStar_SMTEncoding_Term.Term_sort; FStar_SMTEncoding_Term.field_projectible - = true + = field_projectible }) names in let datacons = let uu___7 = FStar_Ident.range_of_lid d in @@ -7033,9 +7036,7 @@ and (encode_sigelt' : se1.FStar_Syntax_Syntax.sigel) ses in let is_injective_on_params = match tycon with - | FStar_Pervasives_Native.None -> - FStar_Compiler_Effect.failwith - "Impossible: Sig_bundle without a Sig_inductive_typ" + | FStar_Pervasives_Native.None -> false | FStar_Pervasives_Native.Some se1 -> is_sig_inductive_injective_on_params env se1 in let uu___2 = diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index 0f55936367d..634967d7279 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -1227,10 +1227,17 @@ let encode_datacon (is_injective_on_tparams:bool) (env:env_t) (se:sigelt) let fuel_var, fuel_tm = fresh_fvar env.current_module_name "f" Fuel_sort in let s_fuel_tm = mkApp("SFuel", [fuel_tm]) in let vars, guards, env', binder_decls, names = encode_binders (Some fuel_tm) formals env in - let fields = names |> List.mapi (fun n x -> - { field_name=mk_term_projector_name d x; - field_sort=Term_sort; - field_projectible=true }) + let fields = + names |> + List.mapi + (fun n x -> + let field_projectible = + n >= n_tps || //either this field is not a type parameter + is_injective_on_tparams //or we are allowed to be injective on parameters + in + { field_name=mk_term_projector_name d x; + field_sort=Term_sort; + field_projectible }) in let datacons = {constr_name=ddconstrsym; @@ -1753,7 +1760,9 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = let tycon = List.tryFind (fun se -> Sig_inductive_typ? se.sigel) ses in let is_injective_on_params = match tycon with - | None -> failwith "Impossible: Sig_bundle without a Sig_inductive_typ" + | None -> + //Exceptions appear as Sig_bundle without an inductive type + false | Some se -> is_sig_inductive_injective_on_params env se in diff --git a/tests/bug-reports/BugBoxInjectivity.fst b/tests/bug-reports/BugBoxInjectivity.fst index 740d264677a..ebf209f7bdf 100644 --- a/tests/bug-reports/BugBoxInjectivity.fst +++ b/tests/bug-reports/BugBoxInjectivity.fst @@ -5,41 +5,20 @@ module CC = FStar.Cardinality.Universes type t (a:Type u#1) : Type u#0 = | Mk : t a -//We can get the problematic axiom by -//relying on an equation introduced by the pattern -//match and give it to SMT let inj_t (#a:Type u#1) (x:t a) : Lemma (x == Mk #a) - [SMTPat (has_type x (t a))] = let Mk #_ = x in () -#push-options "--log_queries" -#restart-solver -let t_injective_alt (f0 f1:Type u#1) (x: t f0) (y:t f1) -: Lemma - (ensures t f0 == t f1 ==> f0 == f1) -= () +[@@expect_failure] +let t_injective : squash (is_inj t) = + introduce forall f0 f1. + t f0 == t f1 ==> f0 == f1 + with introduce _ ==> _ + with _ . ( + inj_t #f0 Mk; + inj_t #f1 (coerce_eq () (Mk #f0)) + ) -// let t_injective (f0 f1:Type u#1) -// : Lemma -// (ensures t f0 == t f1 ==> f0 == f1) -// = t_injective_alt f0 f1 Mk Mk - -// let t_injective' : squash (is_inj t) = -// introduce forall f0 f1. -// t f0 == t f1 ==> f0 == f1 -// with introduce _ ==> _ -// with _ . ( -// t_injective f0 f1 -// ) -// let fals : squash False = -// CC.no_inj_universes_suc t - -// /////////////////// -// let test (#a:Type) (x:t a) = -// match x with -// | Mkt #_ f -> -// assert (x == Mkt #a f) // #restart-solver // #push-options "--log_queries --query_stats --debug BugBoxInjectivity --debug_level SMTEncoding" From ab7931875195c22faba20d56096b914ae150656f Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Fri, 19 Apr 2024 13:47:51 -0700 Subject: [PATCH 035/239] a temporary compat in FStar.ModifiesGen --- ulib/FStar.ModifiesGen.fst | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/ulib/FStar.ModifiesGen.fst b/ulib/FStar.ModifiesGen.fst index 4580060186e..ef75c19d967 100644 --- a/ulib/FStar.ModifiesGen.fst +++ b/ulib/FStar.ModifiesGen.fst @@ -54,6 +54,7 @@ let live_addrs_codom (non_live_addrs_codom regions region_liveness_tags)) (r:addrs_dom regions) = (y: GSet.set nat { GSet.subset (non_live_addrs r) y } ) +#push-options "--ext 'compat:injectivity'" noeq type loc' (#al: aloc_t u#x) (c: cls al) : Type u#x = | Loc: @@ -72,6 +73,7 @@ type loc' (#al: aloc_t u#x) (c: cls al) : Type u#x = Ghost.reveal aux `GSet.subset` (aloc_domain c regions (fun _ -> GSet.complement GSet.empty)) } ) -> loc' c +#pop-options let loc = loc' @@ -618,7 +620,11 @@ let loc_disjoint_aloc_elim #al #c #r1 #a1 #r2 #a2 b1 b2 = #push-options "--z3rlimit 15" let loc_disjoint_addresses_intro #al #c preserve_liveness1 preserve_liveness2 r1 r2 n1 n2 = // FIXME: WHY WHY WHY this assert? - assert (loc_aux_disjoint (Ghost.reveal (Loc?.aux (loc_addresses #_ #c preserve_liveness1 r1 n1))) (Ghost.reveal (Loc?.aux (loc_addresses #_ #c preserve_liveness2 r2 n2)))) + let Loc _ _ _ _ _ = (loc_addresses #_ #c preserve_liveness1 r1 n1) in + let Loc _ _ _ _ _ = (loc_addresses #_ #c preserve_liveness2 r2 n2) in + assert (loc_aux_disjoint + (Ghost.reveal (Loc?.aux (loc_addresses #_ #c preserve_liveness1 r1 n1))) + (Ghost.reveal (Loc?.aux (loc_addresses #_ #c preserve_liveness2 r2 n2)))) #pop-options let loc_disjoint_addresses_elim #al #c preserve_liveness1 preserve_liveness2 r1 r2 n1 n2 = () @@ -947,6 +953,8 @@ let modifies_intro_strong #al #c l h h' regions mrefs lives unused_ins alocs = (Set.mem (HS.frameOf p) (regions_of_loc l) ==> ~ (GSet.mem (HS.as_addr p) (addrs_of_loc l (HS.frameOf p)))))) (ensures (HS.contains h' p /\ HS.sel h' p == HS.sel h p)) = + let Loc _ _ _ _ _ = (loc_mreference #_ #c p) in + let Loc _ _ _ _ _ = l in assert_norm (Loc?.region_liveness_tags (loc_mreference #_ #c p) == Ghost.hide Set.empty); assert (loc_disjoint_region_liveness_tags (loc_mreference p) l); // FIXME: WHY WHY WHY is this assert necessary? From e376ccc6d66bd41874f71dcfe2f6a897801d4a7d Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Fri, 19 Apr 2024 15:38:10 -0700 Subject: [PATCH 036/239] for data constructors on types not injective on their params, add an axiom to prove that the parameter instantiations are irrelevant and remove the projector axiom --- .../generated/FStar_SMTEncoding_Encode.ml | 16 ++- .../generated/FStar_SMTEncoding_Term.ml | 101 +++++++++++++++--- src/smtencoding/FStar.SMTEncoding.Encode.fst | 19 ++-- src/smtencoding/FStar.SMTEncoding.Term.fst | 39 +++++-- src/smtencoding/FStar.SMTEncoding.Term.fsti | 8 +- 5 files changed, 153 insertions(+), 30 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index 18fcd51d3de..5f171b1c4b1 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -4306,7 +4306,8 @@ let (encode_sig_inductive : uu___9; FStar_SMTEncoding_Term.constr_sort = FStar_SMTEncoding_Term.Term_sort; - FStar_SMTEncoding_Term.constr_id = uu___10 + FStar_SMTEncoding_Term.constr_id = uu___10; + FStar_SMTEncoding_Term.constr_base = false } in constructor_or_logic_type_decl uu___8 in let uu___8 = @@ -4506,13 +4507,19 @@ let (encode_datacon : env1 in (match uu___6 with | (vars, guards, env', binder_decls, names) -> + let is_injective_on_tparams1 = + is_injective_on_tparams || + (let uu___7 = + FStar_Options.ext_getv + "compat:injectivity" in + uu___7 <> "") in let fields = FStar_Compiler_List.mapi (fun n -> fun x -> let field_projectible = (n >= n_tps) || - is_injective_on_tparams in + is_injective_on_tparams1 in let uu___7 = FStar_SMTEncoding_Env.mk_term_projector_name d x in @@ -4541,7 +4548,10 @@ let (encode_datacon : FStar_SMTEncoding_Term.constr_sort = FStar_SMTEncoding_Term.Term_sort; FStar_SMTEncoding_Term.constr_id = - uu___9 + uu___9; + FStar_SMTEncoding_Term.constr_base = + (Prims.op_Negation + is_injective_on_tparams1) } in FStar_SMTEncoding_Term.constructor_to_decl uu___7 uu___8 in diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml index 99e85a2c75b..63a65a35a73 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml @@ -258,27 +258,37 @@ type constructor_t = constr_name: Prims.string ; constr_fields: constructor_field Prims.list ; constr_sort: sort ; - constr_id: Prims.int FStar_Pervasives_Native.option } + constr_id: Prims.int FStar_Pervasives_Native.option ; + constr_base: Prims.bool } let (__proj__Mkconstructor_t__item__constr_name : constructor_t -> Prims.string) = fun projectee -> match projectee with - | { constr_name; constr_fields; constr_sort; constr_id;_} -> constr_name + | { constr_name; constr_fields; constr_sort; constr_id; constr_base;_} -> + constr_name let (__proj__Mkconstructor_t__item__constr_fields : constructor_t -> constructor_field Prims.list) = fun projectee -> match projectee with - | { constr_name; constr_fields; constr_sort; constr_id;_} -> + | { constr_name; constr_fields; constr_sort; constr_id; constr_base;_} -> constr_fields let (__proj__Mkconstructor_t__item__constr_sort : constructor_t -> sort) = fun projectee -> match projectee with - | { constr_name; constr_fields; constr_sort; constr_id;_} -> constr_sort + | { constr_name; constr_fields; constr_sort; constr_id; constr_base;_} -> + constr_sort let (__proj__Mkconstructor_t__item__constr_id : constructor_t -> Prims.int FStar_Pervasives_Native.option) = fun projectee -> match projectee with - | { constr_name; constr_fields; constr_sort; constr_id;_} -> constr_id + | { constr_name; constr_fields; constr_sort; constr_id; constr_base;_} -> + constr_id +let (__proj__Mkconstructor_t__item__constr_base : + constructor_t -> Prims.bool) = + fun projectee -> + match projectee with + | { constr_name; constr_fields; constr_sort; constr_id; constr_base;_} -> + constr_base type constructors = constructor_t Prims.list type fact_db_id = | Name of FStar_Ident.lid @@ -1518,7 +1528,6 @@ let (constructor_to_decl : FStar_Compiler_Range_Type.range -> constructor_t -> decl Prims.list) = fun rng -> fun constr -> - let injective = true in let sort1 = constr.constr_sort in let field_sorts = FStar_Compiler_List.map (fun f -> f.field_sort) constr.constr_fields in @@ -1599,6 +1608,70 @@ let (constructor_to_decl : let projs = injective_constructor rng ((constr.constr_name), (constr.constr_fields), sort1) in + let base = + if Prims.op_Negation constr.constr_base + then [] + else + (let arg_sorts = + let uu___1 = + FStar_Compiler_List.filter (fun f -> f.field_projectible) + constr.constr_fields in + FStar_Compiler_List.map (fun uu___2 -> Term_sort) uu___1 in + let base_name = Prims.strcat constr.constr_name "@base" in + let decl1 = + DeclFun + (base_name, arg_sorts, Term_sort, + (FStar_Pervasives_Native.Some "Constructor base")) in + let formals = + FStar_Compiler_List.mapi + (fun i -> + fun uu___1 -> + let uu___2 = + let uu___3 = + let uu___4 = FStar_Compiler_Util.string_of_int i in + Prims.strcat "x" uu___4 in + (uu___3, Term_sort) in + mk_fv uu___2) constr.constr_fields in + let constructed_term = + let uu___1 = + let uu___2 = + FStar_Compiler_List.map (fun fv1 -> mkFreeV fv1 norng) + formals in + ((constr.constr_name), uu___2) in + mkApp uu___1 norng in + let inj_formals = + let uu___1 = + FStar_Compiler_List.map2 + (fun f -> + fun fld -> if fld.field_projectible then [f] else []) + formals constr.constr_fields in + FStar_Compiler_List.flatten uu___1 in + let base_term = + let uu___1 = + let uu___2 = + FStar_Compiler_List.map (fun fv1 -> mkFreeV fv1 norng) + inj_formals in + (base_name, uu___2) in + mkApp uu___1 norng in + let eq = mkEq (constructed_term, base_term) norng in + let guard = + mkApp ((discriminator_name constr), [constructed_term]) norng in + let q = + let uu___1 = + let uu___2 = mkImp (guard, eq) norng in + ([[constructed_term]], formals, uu___2) in + mkForall rng uu___1 in + let a = + let uu___1 = + escape (Prims.strcat "constructor_base_" constr.constr_name) in + { + assumption_term = q; + assumption_caption = + (FStar_Pervasives_Native.Some "Constructor base"); + assumption_name = uu___1; + assumption_fact_ids = [] + } in + [decl1; Assume a]) in let uu___ = let uu___1 = let uu___2 = @@ -1612,10 +1685,12 @@ let (constructor_to_decl : let uu___4 = let uu___5 = let uu___6 = - FStar_Compiler_Util.format1 "" - constr.constr_name in - Caption uu___6 in - [uu___5] in + let uu___7 = + FStar_Compiler_Util.format1 "" + constr.constr_name in + Caption uu___7 in + [uu___6] in + FStar_Compiler_List.op_At base uu___5 in FStar_Compiler_List.op_At [disc] uu___4 in FStar_Compiler_List.op_At projs uu___3 in FStar_Compiler_List.op_At cid uu___2 in @@ -1939,7 +2014,8 @@ and (mkPrelude : Prims.string -> Prims.string) = constr_name = name; constr_fields = uu___1; constr_sort = sort1; - constr_id = (FStar_Pervasives_Native.Some id) + constr_id = (FStar_Pervasives_Native.Some id); + constr_base = false } in let constrs = FStar_Compiler_List.map as_constr @@ -2018,7 +2094,8 @@ let (mkBvConstructor : constr_name = uu___; constr_fields = uu___1; constr_sort = Term_sort; - constr_id = FStar_Pervasives_Native.None + constr_id = FStar_Pervasives_Native.None; + constr_base = false } in let uu___ = constructor_to_decl norng constr in (uu___, (constr.constr_name), (discriminator_name constr)) diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index 634967d7279..7396d59bd8c 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -1174,7 +1174,8 @@ let encode_sig_inductive (is_injective_on_params:bool) (env:env_t) (se:sigelt) constr_fields = vars |> List.map (fun fv -> {field_name=tname^fv_name fv; field_sort=fv_sort fv; field_projectible=false}) ; //The field_projectible=false above is extremely important; it makes sure that type-formers are not injective constr_sort=Term_sort; - constr_id=Some (varops.next_id()) + constr_id=Some (varops.next_id()); + constr_base=false } in let tok_decls, env = @@ -1227,6 +1228,9 @@ let encode_datacon (is_injective_on_tparams:bool) (env:env_t) (se:sigelt) let fuel_var, fuel_tm = fresh_fvar env.current_module_name "f" Fuel_sort in let s_fuel_tm = mkApp("SFuel", [fuel_tm]) in let vars, guards, env', binder_decls, names = encode_binders (Some fuel_tm) formals env in + let is_injective_on_tparams = + is_injective_on_tparams || Options.ext_getv "compat:injectivity" <> "" + in let fields = names |> List.mapi @@ -1239,12 +1243,13 @@ let encode_datacon (is_injective_on_tparams:bool) (env:env_t) (se:sigelt) field_sort=Term_sort; field_projectible }) in - let datacons = - {constr_name=ddconstrsym; - constr_fields=fields; - constr_sort=Term_sort; - constr_id=Some (varops.next_id()) - } |> Term.constructor_to_decl (Ident.range_of_lid d) in + let datacons = { + constr_name=ddconstrsym; + constr_fields=fields; + constr_sort=Term_sort; + constr_id=Some (varops.next_id()); + constr_base=not is_injective_on_tparams + } |> Term.constructor_to_decl (Ident.range_of_lid d) in let app = mk_Apply ddtok_tm vars in let guard = mk_and_l guards in let xvars = List.map mkFreeV vars in diff --git a/src/smtencoding/FStar.SMTEncoding.Term.fst b/src/smtencoding/FStar.SMTEncoding.Term.fst index caa0b727566..93ceba286ee 100644 --- a/src/smtencoding/FStar.SMTEncoding.Term.fst +++ b/src/smtencoding/FStar.SMTEncoding.Term.fst @@ -18,8 +18,6 @@ module FStar.SMTEncoding.Term open FStar open FStar.Compiler open FStar.Compiler.Effect -open FStar.Compiler.List -open FStar.Class.Ord module S = FStar.Syntax.Syntax module BU = FStar.Compiler.Util @@ -601,7 +599,6 @@ let injective_constructor let discriminator_name constr = "is-"^constr.constr_name let constructor_to_decl rng constr = - let injective = true in let sort = constr.constr_sort in let field_sorts = constr.constr_fields |> List.map (fun f -> f.field_sort) in let cdecl = DeclFun(constr.constr_name, field_sorts, constr.constr_sort, Some "Constructor") in @@ -638,8 +635,36 @@ let constructor_to_decl rng constr = Some "Discriminator definition") in def in let projs = injective_constructor rng (constr.constr_name, constr.constr_fields, sort) in + let base = + if not constr.constr_base + then [] + else ( + let arg_sorts = + constr.constr_fields + |> List.filter (fun f -> f.field_projectible) + |> List.map (fun _ -> Term_sort) + in + let base_name = constr.constr_name ^ "@base" in + let decl = DeclFun(base_name, arg_sorts, Term_sort, Some "Constructor base") in + let formals = List.mapi (fun i _ -> mk_fv ("x" ^ string_of_int i, Term_sort)) constr.constr_fields in + let constructed_term = mkApp(constr.constr_name, List.map (fun fv -> mkFreeV fv norng) formals) norng in + let inj_formals = List.flatten <| List.map2 (fun f fld -> if fld.field_projectible then [f] else []) formals constr.constr_fields in + let base_term = mkApp(base_name, List.map (fun fv -> mkFreeV fv norng) inj_formals) norng in + let eq = mkEq(constructed_term, base_term) norng in + let guard = mkApp(discriminator_name constr, [constructed_term]) norng in + let q = mkForall rng ([[constructed_term]], formals, mkImp (guard, eq) norng) in + //forall (x0...xn:Term). {:pattern (C x0 ...xn)} is-C (C x0..xn) ==> C x0..xn == C-base x2 x3..xn + let a = { + assumption_name=escape ("constructor_base_" ^ constr.constr_name); + assumption_caption=Some "Constructor base"; + assumption_term=q; + assumption_fact_ids=[] + } in + [decl; Assume a] + ) + in Caption (format1 "" constr.constr_name):: - [cdecl]@cid@projs@[disc] + [cdecl]@cid@projs@[disc]@base @[Caption (format1 "" constr.constr_name)] (****************************************************************************) @@ -906,7 +931,8 @@ and mkPrelude z3options = = { constr_name=name; constr_fields=List.map (fun (field_name, field_sort, field_projectible) -> {field_name; field_sort; field_projectible}) fields; constr_sort=sort; - constr_id=Some id } + constr_id=Some id; + constr_base=false } in let constrs : constructors = List.map as_constr @@ -986,7 +1012,8 @@ let mkBvConstructor (sz : int) = constr_name=fst (boxBitVecFun sz); constr_sort=Term_sort; constr_id=None; - constr_fields=[{field_projectible=true; field_name=snd (boxBitVecFun sz); field_sort=BitVec_sort sz }] + constr_fields=[{field_projectible=true; field_name=snd (boxBitVecFun sz); field_sort=BitVec_sort sz }]; + constr_base=false } in constructor_to_decl norng constr, constr.constr_name, diff --git a/src/smtencoding/FStar.SMTEncoding.Term.fsti b/src/smtencoding/FStar.SMTEncoding.Term.fsti index 462b1c41477..e76808f9dd2 100644 --- a/src/smtencoding/FStar.SMTEncoding.Term.fsti +++ b/src/smtencoding/FStar.SMTEncoding.Term.fsti @@ -20,6 +20,8 @@ open FStar.Compiler open FStar.Compiler.Effect open FStar.Compiler.Util open FStar.Class.Show +open FStar.Compiler.List +open FStar.Class.Ord module S = FStar.Syntax.Syntax @@ -102,8 +104,10 @@ type constructor_t = { constr_name:string; constr_fields:list constructor_field; constr_sort:sort; - constr_id:option int; //Some i, if a term whose head is this constructor is distinct from - //terms with other head constructors + constr_id:option int; + //Some i, if a term whose head is this constructor is distinct from + //terms with other head constructors + constr_base: bool; //generate a base to eliminate non-injective arguments } type constructors = list constructor_t type fact_db_id = From db285dbf6e869df148315fde17c8cc6eecc2ebf8 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Fri, 19 Apr 2024 16:14:32 -0700 Subject: [PATCH 037/239] remove compat options in ModifiesGen --- ulib/FStar.ModifiesGen.fst | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/ulib/FStar.ModifiesGen.fst b/ulib/FStar.ModifiesGen.fst index ef75c19d967..118c6a4b50c 100644 --- a/ulib/FStar.ModifiesGen.fst +++ b/ulib/FStar.ModifiesGen.fst @@ -54,7 +54,6 @@ let live_addrs_codom (non_live_addrs_codom regions region_liveness_tags)) (r:addrs_dom regions) = (y: GSet.set nat { GSet.subset (non_live_addrs r) y } ) -#push-options "--ext 'compat:injectivity'" noeq type loc' (#al: aloc_t u#x) (c: cls al) : Type u#x = | Loc: @@ -73,7 +72,6 @@ type loc' (#al: aloc_t u#x) (c: cls al) : Type u#x = Ghost.reveal aux `GSet.subset` (aloc_domain c regions (fun _ -> GSet.complement GSet.empty)) } ) -> loc' c -#pop-options let loc = loc' @@ -958,9 +956,9 @@ let modifies_intro_strong #al #c l h h' regions mrefs lives unused_ins alocs = assert_norm (Loc?.region_liveness_tags (loc_mreference #_ #c p) == Ghost.hide Set.empty); assert (loc_disjoint_region_liveness_tags (loc_mreference p) l); // FIXME: WHY WHY WHY is this assert necessary? - assert_spinoff (loc_aux_disjoint (Ghost.reveal (Loc?.aux (loc_mreference p))) (Ghost.reveal (Loc?.aux l))); + assert (loc_aux_disjoint (Ghost.reveal (Loc?.aux (loc_mreference p))) (Ghost.reveal (Loc?.aux l))); // FIXME: Now this one is too :) - assert (loc_disjoint_addrs (loc_mreference p) l); + assert_spinoff (loc_disjoint_addrs (loc_mreference p) l); assert ((loc_disjoint (loc_mreference p) l)); mrefs t pre p in @@ -1315,6 +1313,7 @@ let modifies_loc_addresses_intro_weak modifies_preserves_alocs_intro (loc_union (loc_addresses true r s) l) h1 h2 () (fun r' a b -> if r = r' then f a b else () ) +#push-options "--z3rlimit_factor 4" let modifies_loc_addresses_intro #al #c r s l h1 h2 = loc_includes_loc_regions_restrict_to_regions l (Set.singleton r); loc_includes_loc_union_restrict_to_regions l (Set.singleton r); @@ -1472,6 +1471,8 @@ let disjoint_addrs_of_loc_loc_disjoint )) (ensures (loc_disjoint l1 l2)) = // FIXME: WHY WHY WHY do I need this assert? + let Loc _ _ _ _ _ = l1 in + let Loc _ _ _ _ _ = l2 in let l1' = Ghost.reveal (Loc?.aux l1) in let l2' = Ghost.reveal (Loc?.aux l2) in assert (forall (b1 b2: aloc c) . (GSet.mem b1 l1' /\ GSet.mem b2 l2') ==> aloc_disjoint b1 b2) From 2365f171d261478adbda8f81ee5c0bdfc960c9a6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 19 Apr 2024 14:12:58 -0700 Subject: [PATCH 038/239] Tc.Quals: nit --- src/typechecker/FStar.TypeChecker.Quals.fst | 36 ++++++++++----------- 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.Quals.fst b/src/typechecker/FStar.TypeChecker.Quals.fst index 5eed1531e85..a7fca344a8e 100644 --- a/src/typechecker/FStar.TypeChecker.Quals.fst +++ b/src/typechecker/FStar.TypeChecker.Quals.fst @@ -289,26 +289,26 @@ let check_typeclass_instance_attribute env rng se = in let check_instance_typ (ty:typ) : unit = let _, res = U.arrow_formals_comp ty in - if U.is_total_comp res - then let t = U.comp_result res in - let head, _ = U.head_and_args t in - let err () = - FStar.Errors.log_issue_doc rng (FStar.Errors.Error_UnexpectedTypeclassInstance, [ - text "Instances must define instances of `class` types."; - text "Type" ^/^ pp t ^/^ text "is not a class."; - ]) - in - match (U.un_uinst head).n with - | Tm_fvar fv -> - if not (Env.fv_has_attr env fv FStar.Parser.Const.tcclass_lid) - then err () - | _ -> - err () - else - FStar.Errors.log_issue_doc rng (FStar.Errors.Error_UnexpectedTypeclassInstance, [ + if not (U.is_total_comp res) then + log_issue_doc rng (FStar.Errors.Error_UnexpectedTypeclassInstance, [ text "Instances are expected to be total."; text "This instance has effect" ^^ pp (U.comp_effect_name res); - ]) + ]); + + let t = U.comp_result res in + let head, _ = U.head_and_args t in + let err () = + FStar.Errors.log_issue_doc rng (FStar.Errors.Error_UnexpectedTypeclassInstance, [ + text "Instances must define instances of `class` types."; + text "Type" ^/^ pp t ^/^ text "is not a class."; + ]) + in + match (U.un_uinst head).n with + | Tm_fvar fv -> + if not (Env.fv_has_attr env fv FStar.Parser.Const.tcclass_lid) then + err () + | _ -> + err () in if is_tc_instance then match se.sigel with From 1cc1080b25d24e59aaaead33e8dafd599e1f1034 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 19 Apr 2024 16:14:24 -0700 Subject: [PATCH 039/239] Tactics: introduce set_dump_on_failure This allows tactics to control whether we should dump the proofstate when they fail. Also, call_subtac sets this to false automatically. Fixes FStarLang/pulse#60 --- ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml | 1 + src/tactics/FStar.Tactics.Interpreter.fst | 3 ++- src/tactics/FStar.Tactics.Types.fsti | 2 ++ src/tactics/FStar.Tactics.V2.Basic.fst | 8 ++++++++ src/tactics/FStar.Tactics.V2.Basic.fsti | 1 + src/tactics/FStar.Tactics.V2.Primops.fst | 1 + ulib/FStar.Stubs.Tactics.V2.Builtins.fsti | 5 +++++ 7 files changed, 20 insertions(+), 1 deletion(-) diff --git a/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml b/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml index e9e1ea19382..a24499a2a90 100644 --- a/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml +++ b/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml @@ -111,6 +111,7 @@ let tadmit_t = from_tac_1 "B.tadmit_t" B.tadmit_t let join = from_tac_1 "B.join" B.join let curms = from_tac_1 "B.curms" B.curms let set_urgency = from_tac_1 "B.set_urgency" B.set_urgency +let set_dump_on_failure = from_tac_1 "B.set_dump_on_failure" B.set_dump_on_failure let t_commute_applied_match = from_tac_1 "B.t_commute_applied_match" B.t_commute_applied_match let gather_or_solve_explicit_guards_for_resolved_goals = from_tac_1 "B.gather_explicit_guards_for_resolved_goals" B.gather_explicit_guards_for_resolved_goals let string_to_term = from_tac_2 "B.string_to_term" B.string_to_term diff --git a/src/tactics/FStar.Tactics.Interpreter.fst b/src/tactics/FStar.Tactics.Interpreter.fst index 951ec71af94..bcde515e2d4 100644 --- a/src/tactics/FStar.Tactics.Interpreter.fst +++ b/src/tactics/FStar.Tactics.Interpreter.fst @@ -366,7 +366,8 @@ let run_unembedded_tactic_on_ps (* Any other error, including exceptions being raised by the metaprograms. *) | Failed (e, ps) -> - do_dump_proofstate ps "at the time of failure"; + if ps.dump_on_failure then + do_dump_proofstate ps "at the time of failure"; let open FStar.Pprint in let texn_to_doc e = match e with diff --git a/src/tactics/FStar.Tactics.Types.fsti b/src/tactics/FStar.Tactics.Types.fsti index 1988282d9ac..2a1acc0b8e3 100644 --- a/src/tactics/FStar.Tactics.Types.fsti +++ b/src/tactics/FStar.Tactics.Types.fsti @@ -77,6 +77,8 @@ type proofstate = { urgency : int; // When printing a proofstate due to an error, this // is used by emacs to decide whether it should pop // open a buffer or not (default: 1). + + dump_on_failure : bool; // Whether to dump the proofstate to the user when a failure occurs. } val decr_depth : proofstate -> proofstate diff --git a/src/tactics/FStar.Tactics.V2.Basic.fst b/src/tactics/FStar.Tactics.V2.Basic.fst index 9b885c41bc5..f27163adb27 100644 --- a/src/tactics/FStar.Tactics.V2.Basic.fst +++ b/src/tactics/FStar.Tactics.V2.Basic.fst @@ -1960,6 +1960,11 @@ let set_urgency (u:Z.t) : tac unit = let ps = { ps with urgency = Z.to_int_fs u } in set ps +let set_dump_on_failure (b:bool) : tac unit = + let! ps = get in + let ps = { ps with dump_on_failure = b } in + set ps + let t_commute_applied_match () : tac unit = wrap_err "t_commute_applied_match" <| ( let! g = cur_goal in match destruct_eq (goal_env g) (goal_type g) with @@ -2786,6 +2791,7 @@ let proofstate_of_goals rng env goals imps = tac_verb_dbg = Env.debug env (Options.Other "TacVerbose"); local_state = BU.psmap_empty (); urgency = 1; + dump_on_failure = true; } in ps @@ -2815,6 +2821,7 @@ let proofstate_of_all_implicits rng env imps = tac_verb_dbg = Env.debug env (Options.Other "TacVerbose"); local_state = BU.psmap_empty (); urgency = 1; + dump_on_failure = true; } in (ps, w) @@ -2851,6 +2858,7 @@ let call_subtac (g:env) (f : tac unit) (_u:universe) (goal_ty : typ) : tac (opti return ();! // thunk let rng = Env.get_range g in let ps, w = proofstate_of_goal_ty rng g goal_ty in + let ps = { ps with dump_on_failure = false } in // subtacs can fail gracefully, do not dump the failed proofstate. match Errors.catch_errors_and_ignore_rest (fun () -> run_unembedded_tactic_on_ps_and_solve_remaining rng rng false () (fun () -> f) ps) with diff --git a/src/tactics/FStar.Tactics.V2.Basic.fsti b/src/tactics/FStar.Tactics.V2.Basic.fsti index ae3379cc5ce..bdbd3ced32f 100644 --- a/src/tactics/FStar.Tactics.V2.Basic.fsti +++ b/src/tactics/FStar.Tactics.V2.Basic.fsti @@ -98,6 +98,7 @@ val lget : typ -> string -> tac term val lset : typ -> string -> term -> tac unit val curms : unit -> tac Z.t val set_urgency : Z.t -> tac unit +val set_dump_on_failure : bool -> tac unit val t_commute_applied_match : unit -> tac unit val string_to_term : env -> string -> tac term val push_bv_dsenv : env -> string -> tac (env * RD.binding) diff --git a/src/tactics/FStar.Tactics.V2.Primops.fst b/src/tactics/FStar.Tactics.V2.Primops.fst index cff3bb45cc6..13f9e4e847b 100644 --- a/src/tactics/FStar.Tactics.V2.Primops.fst +++ b/src/tactics/FStar.Tactics.V2.Primops.fst @@ -193,6 +193,7 @@ let ops = [ (fun _ _ _ -> fail "sorry, `lset` does not work in NBE"); mk_tac_step_1 1 "set_urgency" set_urgency set_urgency; + mk_tac_step_1 1 "set_dump_on_failure" set_dump_on_failure set_dump_on_failure; mk_tac_step_1 1 "t_commute_applied_match" t_commute_applied_match t_commute_applied_match; mk_tac_step_1 0 "gather_or_solve_explicit_guards_for_resolved_goals" gather_explicit_guards_for_resolved_goals diff --git a/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti b/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti index 71a985a900d..3ae34455fd4 100644 --- a/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti +++ b/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti @@ -383,6 +383,11 @@ val curms : unit -> Tac int before raising an exception (see e.g. [fail_silently]). *) val set_urgency : int -> TacS unit +(** [set_dump_failure b] controls whether the engine will dump out +the proofstate if a tactic fails during exception. This is true by +default, but can be disabled to get less verbosity. *) +val set_dump_on_failure : bool -> TacS unit + (** [string_to_term e s] runs the F* parser on the string [s] in the environment [e], and produces a term. *) val string_to_term : env -> string -> Tac term From 00bbbcf2ffd746c4114a00aea3d98cbd3b80b4dc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 19 Apr 2024 14:13:05 -0700 Subject: [PATCH 040/239] snap --- .../generated/FStar_Tactics_Interpreter.ml | 15 +- .../generated/FStar_Tactics_Monad.ml | 59 +++-- .../generated/FStar_Tactics_Types.ml | 53 +++-- .../generated/FStar_Tactics_V1_Basic.ml | 42 +++- .../generated/FStar_Tactics_V2_Basic.ml | 101 +++++++- .../generated/FStar_Tactics_V2_Primops.ml | 222 ++++++++++-------- .../generated/FStar_TypeChecker_Quals.ml | 121 +++++----- 7 files changed, 394 insertions(+), 219 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Interpreter.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Interpreter.ml index d8475edf75c..110a60836f8 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Interpreter.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Interpreter.ml @@ -777,7 +777,9 @@ let run_unembedded_tactic_on_ps : FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (ps.FStar_Tactics_Types.urgency) + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in let ps2 = { @@ -909,7 +911,9 @@ let run_unembedded_tactic_on_ps : FStar_Tactics_Types.local_state = (ps1.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (ps1.FStar_Tactics_Types.urgency) + (ps1.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps1.FStar_Tactics_Types.dump_on_failure) } in let env = ps2.FStar_Tactics_Types.main_context in let res = @@ -1068,8 +1072,11 @@ let run_unembedded_tactic_on_ps : FStar_Compiler_Effect.raise (FStar_Errors.Err (code, msg1, ctx)) | FStar_Tactics_Result.Failed (e, ps3) -> - (FStar_Tactics_Printing.do_dump_proofstate ps3 - "at the time of failure"; + (if ps3.FStar_Tactics_Types.dump_on_failure + then + FStar_Tactics_Printing.do_dump_proofstate ps3 + "at the time of failure" + else (); (let texn_to_doc e1 = match e1 with | FStar_Tactics_Common.TacticFailure msg -> msg diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Monad.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Monad.ml index 53393bbcb57..f31ba5a4957 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Monad.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Monad.ml @@ -343,7 +343,9 @@ let catch : 'a . 'a tac -> (Prims.exn, 'a) FStar_Pervasives.either tac = FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (ps.FStar_Tactics_Types.urgency) + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in FStar_Tactics_Result.Success ((FStar_Pervasives.Inl m), ps1)))) let recover : 'a . 'a tac -> (Prims.exn, 'a) FStar_Pervasives.either tac = @@ -508,7 +510,9 @@ let (set_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) }) let (set_smt_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = fun gs -> @@ -535,7 +539,9 @@ let (set_smt_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) }) let (cur_goals : FStar_Tactics_Types.goal Prims.list tac) = bind get (fun ps -> ret ps.FStar_Tactics_Types.goals) @@ -595,7 +601,9 @@ let (dismiss : unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in set uu___) let (replace_cur : FStar_Tactics_Types.goal -> unit tac) = @@ -629,7 +637,9 @@ let (replace_cur : FStar_Tactics_Types.goal -> unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in set uu___1)) let (getopts : FStar_Options.optionstate tac) = @@ -668,7 +678,9 @@ let (add_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) }) let (add_smt_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = fun gs -> @@ -697,7 +709,9 @@ let (add_smt_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) }) let (push_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = fun gs -> @@ -727,7 +741,9 @@ let (push_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) }) let (push_smt_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = fun gs -> @@ -756,7 +772,9 @@ let (push_smt_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) }) let (add_implicits : FStar_TypeChecker_Env.implicits -> unit tac) = fun i -> @@ -785,7 +803,9 @@ let (add_implicits : FStar_TypeChecker_Env.implicits -> unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) }) let (new_uvar : Prims.string -> @@ -1003,7 +1023,9 @@ let (compress_implicits : unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in set ps') let (get_phi : @@ -1139,7 +1161,10 @@ let divide : 'a 'b . FStar_BigInt.t -> 'a tac -> 'b tac -> ('a * 'b) tac = = (p.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (p.FStar_Tactics_Types.urgency) + (p.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure + = + (p.FStar_Tactics_Types.dump_on_failure) } in let uu___2 = set lp in Obj.magic @@ -1210,7 +1235,10 @@ let divide : 'a 'b . FStar_BigInt.t -> 'a tac -> 'b tac -> ('a * 'b) tac = (lp'.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (lp'.FStar_Tactics_Types.urgency) + (lp'.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure + = + (lp'.FStar_Tactics_Types.dump_on_failure) } in let uu___4 = set rp in @@ -1299,7 +1327,10 @@ let divide : 'a 'b . FStar_BigInt.t -> 'a tac -> 'b tac -> ('a * 'b) tac = (rp'.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (rp'.FStar_Tactics_Types.urgency) + (rp'.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure + = + (rp'.FStar_Tactics_Types.dump_on_failure) } in let uu___6 = set p' in diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Types.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Types.ml index ce150fcee94..895b39e158b 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Types.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Types.ml @@ -60,91 +60,104 @@ type proofstate = freshness: Prims.int ; tac_verb_dbg: Prims.bool ; local_state: FStar_Syntax_Syntax.term FStar_Compiler_Util.psmap ; - urgency: Prims.int } + urgency: Prims.int ; + dump_on_failure: Prims.bool } let (__proj__Mkproofstate__item__main_context : proofstate -> FStar_TypeChecker_Env.env) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> main_context + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> + main_context let (__proj__Mkproofstate__item__all_implicits : proofstate -> FStar_TypeChecker_Common.implicits) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> all_implicits + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> + all_implicits let (__proj__Mkproofstate__item__goals : proofstate -> goal Prims.list) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> goals + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> goals let (__proj__Mkproofstate__item__smt_goals : proofstate -> goal Prims.list) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> smt_goals + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> smt_goals let (__proj__Mkproofstate__item__depth : proofstate -> Prims.int) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> depth + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> depth let (__proj__Mkproofstate__item____dump : proofstate -> proofstate -> Prims.string -> unit) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> __dump + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> __dump let (__proj__Mkproofstate__item__psc : proofstate -> FStar_TypeChecker_Primops_Base.psc) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> psc + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> psc let (__proj__Mkproofstate__item__entry_range : proofstate -> FStar_Compiler_Range_Type.range) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> entry_range + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> entry_range let (__proj__Mkproofstate__item__guard_policy : proofstate -> guard_policy) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> guard_policy1 + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> + guard_policy1 let (__proj__Mkproofstate__item__freshness : proofstate -> Prims.int) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> freshness + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> freshness let (__proj__Mkproofstate__item__tac_verb_dbg : proofstate -> Prims.bool) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> tac_verb_dbg + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> + tac_verb_dbg let (__proj__Mkproofstate__item__local_state : proofstate -> FStar_Syntax_Syntax.term FStar_Compiler_Util.psmap) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> local_state + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> local_state let (__proj__Mkproofstate__item__urgency : proofstate -> Prims.int) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> urgency + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> urgency +let (__proj__Mkproofstate__item__dump_on_failure : proofstate -> Prims.bool) + = + fun projectee -> + match projectee with + | { main_context; all_implicits; goals; smt_goals; depth; __dump; + psc; entry_range; guard_policy = guard_policy1; freshness; + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> + dump_on_failure let (goal_env : goal -> FStar_TypeChecker_Env.env) = fun g -> g.goal_main_env let (goal_range : goal -> FStar_Compiler_Range_Type.range) = fun g -> (g.goal_main_env).FStar_TypeChecker_Env.range @@ -342,7 +355,8 @@ let (decr_depth : proofstate -> proofstate) = freshness = (ps.freshness); tac_verb_dbg = (ps.tac_verb_dbg); local_state = (ps.local_state); - urgency = (ps.urgency) + urgency = (ps.urgency); + dump_on_failure = (ps.dump_on_failure) } let (incr_depth : proofstate -> proofstate) = fun ps -> @@ -359,7 +373,8 @@ let (incr_depth : proofstate -> proofstate) = freshness = (ps.freshness); tac_verb_dbg = (ps.tac_verb_dbg); local_state = (ps.local_state); - urgency = (ps.urgency) + urgency = (ps.urgency); + dump_on_failure = (ps.dump_on_failure) } let (set_ps_psc : FStar_TypeChecker_Primops_Base.psc -> proofstate -> proofstate) = @@ -378,7 +393,8 @@ let (set_ps_psc : freshness = (ps.freshness); tac_verb_dbg = (ps.tac_verb_dbg); local_state = (ps.local_state); - urgency = (ps.urgency) + urgency = (ps.urgency); + dump_on_failure = (ps.dump_on_failure) } let (tracepoint_with_psc : FStar_TypeChecker_Primops_Base.psc -> proofstate -> Prims.bool) = @@ -419,7 +435,8 @@ let (set_proofstate_range : freshness = (ps.freshness); tac_verb_dbg = (ps.tac_verb_dbg); local_state = (ps.local_state); - urgency = (ps.urgency) + urgency = (ps.urgency); + dump_on_failure = (ps.dump_on_failure) } let (goals_of : proofstate -> goal Prims.list) = fun ps -> ps.goals let (smt_goals_of : proofstate -> goal Prims.list) = fun ps -> ps.smt_goals diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml index b1e575d08af..ff65da4b13b 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml @@ -244,7 +244,9 @@ let (dump_all : Prims.bool -> Prims.string -> unit FStar_Tactics_Monad.tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in do_dump_ps msg ps'; FStar_Tactics_Result.Success ((), ps)) let (dump_uvars_of : @@ -287,7 +289,9 @@ let (dump_uvars_of : (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in do_dump_ps msg ps'; FStar_Tactics_Result.Success ((), ps)) let fail1 : @@ -424,7 +428,9 @@ let (set_guard_policy : (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) }) let with_policy : 'a . @@ -1417,7 +1423,9 @@ let (fresh : unit -> FStar_BigInt.t FStar_Tactics_Monad.tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in let uu___2 = FStar_Tactics_Monad.set ps1 in let uu___3 = bind () in @@ -2282,7 +2290,9 @@ let divide : FStar_Tactics_Types.local_state = (p.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (p.FStar_Tactics_Types.urgency) + (p.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (p.FStar_Tactics_Types.dump_on_failure) } in let uu___4 = FStar_Tactics_Monad.set lp in let uu___5 = bind () in @@ -2319,7 +2329,10 @@ let divide : FStar_Tactics_Types.local_state = (lp'.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (lp'.FStar_Tactics_Types.urgency) + (lp'.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure + = + (lp'.FStar_Tactics_Types.dump_on_failure) } in let uu___9 = FStar_Tactics_Monad.set rp in let uu___10 = bind () in @@ -2378,7 +2391,10 @@ let divide : (rp'.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (rp'.FStar_Tactics_Types.urgency) + (rp'.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure + = + (rp'.FStar_Tactics_Types.dump_on_failure) } in let uu___14 = FStar_Tactics_Monad.set @@ -6081,7 +6097,9 @@ let (join : unit -> unit FStar_Tactics_Monad.tac) = FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (ps.FStar_Tactics_Types.urgency) + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in Obj.magic (FStar_Class_Monad.op_let_Bang @@ -8811,7 +8829,9 @@ let (lset : (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = uu___1; FStar_Tactics_Types.urgency = - (ps.FStar_Tactics_Types.urgency) + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in Obj.magic (FStar_Tactics_Monad.set ps1)) uu___1) in FStar_Tactics_Monad.wrap_err "lset" uu___ @@ -8845,7 +8865,9 @@ let (set_urgency : FStar_BigInt.t -> unit FStar_Tactics_Monad.tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = uu___ + FStar_Tactics_Types.urgency = uu___; + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in Obj.magic (FStar_Tactics_Monad.set ps1)) uu___) let (t_commute_applied_match : unit -> unit FStar_Tactics_Monad.tac) = diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml index 5c51f84018c..c4de81c8b82 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml @@ -194,7 +194,9 @@ let (dump_all : Prims.bool -> Prims.string -> unit FStar_Tactics_Monad.tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in do_dump_ps msg ps'; FStar_Tactics_Result.Success ((), ps)) let (dump_uvars_of : @@ -237,7 +239,9 @@ let (dump_uvars_of : (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in do_dump_ps msg ps'; FStar_Tactics_Result.Success ((), ps)) let fail1 : @@ -387,7 +391,9 @@ let (set_guard_policy : FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (ps.FStar_Tactics_Types.urgency) + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) })) uu___) let with_policy : 'a . @@ -1708,7 +1714,9 @@ let (fresh : unit -> FStar_BigInt.t FStar_Tactics_Monad.tac) = FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (ps.FStar_Tactics_Types.urgency) + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in let uu___1 = FStar_Tactics_Monad.set ps1 in Obj.magic @@ -6627,7 +6635,9 @@ let (join : unit -> unit FStar_Tactics_Monad.tac) = FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (ps.FStar_Tactics_Types.urgency) + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in Obj.magic (FStar_Class_Monad.op_let_Bang @@ -9013,7 +9023,9 @@ let (lset : (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = uu___1; FStar_Tactics_Types.urgency = - (ps.FStar_Tactics_Types.urgency) + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in Obj.magic (FStar_Tactics_Monad.set ps1)) uu___1) in FStar_Tactics_Monad.wrap_err "lset" uu___ @@ -9047,7 +9059,43 @@ let (set_urgency : FStar_BigInt.t -> unit FStar_Tactics_Monad.tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = uu___ + FStar_Tactics_Types.urgency = uu___; + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) + } in + Obj.magic (FStar_Tactics_Monad.set ps1)) uu___) +let (set_dump_on_failure : Prims.bool -> unit FStar_Tactics_Monad.tac) = + fun b -> + FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () + (Obj.magic FStar_Tactics_Monad.get) + (fun uu___ -> + (fun ps -> + let ps = Obj.magic ps in + let ps1 = + { + FStar_Tactics_Types.main_context = + (ps.FStar_Tactics_Types.main_context); + FStar_Tactics_Types.all_implicits = + (ps.FStar_Tactics_Types.all_implicits); + FStar_Tactics_Types.goals = (ps.FStar_Tactics_Types.goals); + FStar_Tactics_Types.smt_goals = + (ps.FStar_Tactics_Types.smt_goals); + FStar_Tactics_Types.depth = (ps.FStar_Tactics_Types.depth); + FStar_Tactics_Types.__dump = (ps.FStar_Tactics_Types.__dump); + FStar_Tactics_Types.psc = (ps.FStar_Tactics_Types.psc); + FStar_Tactics_Types.entry_range = + (ps.FStar_Tactics_Types.entry_range); + FStar_Tactics_Types.guard_policy = + (ps.FStar_Tactics_Types.guard_policy); + FStar_Tactics_Types.freshness = + (ps.FStar_Tactics_Types.freshness); + FStar_Tactics_Types.tac_verb_dbg = + (ps.FStar_Tactics_Types.tac_verb_dbg); + FStar_Tactics_Types.local_state = + (ps.FStar_Tactics_Types.local_state); + FStar_Tactics_Types.urgency = + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = b } in Obj.magic (FStar_Tactics_Monad.set ps1)) uu___) let (t_commute_applied_match : unit -> unit FStar_Tactics_Monad.tac) = @@ -12543,7 +12591,8 @@ let (proofstate_of_goals : FStar_Tactics_Types.freshness = Prims.int_zero; FStar_Tactics_Types.tac_verb_dbg = uu___; FStar_Tactics_Types.local_state = uu___1; - FStar_Tactics_Types.urgency = Prims.int_one + FStar_Tactics_Types.urgency = Prims.int_one; + FStar_Tactics_Types.dump_on_failure = true } in ps let (proofstate_of_goal_ty : @@ -12699,7 +12748,8 @@ let (proofstate_of_all_implicits : FStar_Tactics_Types.freshness = Prims.int_zero; FStar_Tactics_Types.tac_verb_dbg = uu___; FStar_Tactics_Types.local_state = uu___1; - FStar_Tactics_Types.urgency = Prims.int_one + FStar_Tactics_Types.urgency = Prims.int_one; + FStar_Tactics_Types.dump_on_failure = true } in (ps, w) let (getprop : @@ -12793,12 +12843,43 @@ let (call_subtac : proofstate_of_goal_ty rng g goal_ty in match uu___2 with | (ps, w) -> + let ps1 = + { + FStar_Tactics_Types.main_context = + (ps.FStar_Tactics_Types.main_context); + FStar_Tactics_Types.all_implicits = + (ps.FStar_Tactics_Types.all_implicits); + FStar_Tactics_Types.goals = + (ps.FStar_Tactics_Types.goals); + FStar_Tactics_Types.smt_goals = + (ps.FStar_Tactics_Types.smt_goals); + FStar_Tactics_Types.depth = + (ps.FStar_Tactics_Types.depth); + FStar_Tactics_Types.__dump = + (ps.FStar_Tactics_Types.__dump); + FStar_Tactics_Types.psc = + (ps.FStar_Tactics_Types.psc); + FStar_Tactics_Types.entry_range = + (ps.FStar_Tactics_Types.entry_range); + FStar_Tactics_Types.guard_policy = + (ps.FStar_Tactics_Types.guard_policy); + FStar_Tactics_Types.freshness = + (ps.FStar_Tactics_Types.freshness); + FStar_Tactics_Types.tac_verb_dbg = + (ps.FStar_Tactics_Types.tac_verb_dbg); + FStar_Tactics_Types.local_state = + (ps.FStar_Tactics_Types.local_state); + FStar_Tactics_Types.urgency = + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + false + } in let uu___3 = FStar_Errors.catch_errors_and_ignore_rest (fun uu___4 -> run_unembedded_tactic_on_ps_and_solve_remaining rng rng false () (fun uu___5 -> f) - ps) in + ps1) in (match uu___3 with | ([], FStar_Pervasives_Native.Some ()) -> Obj.magic diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Primops.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Primops.ml index 487bf630c30..26781aede39 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Primops.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Primops.ml @@ -997,6 +997,19 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_one + "set_dump_on_failure" + FStar_Syntax_Embeddings.e_bool + FStar_Syntax_Embeddings.e_unit + FStar_TypeChecker_NBETerm.e_bool + FStar_TypeChecker_NBETerm.e_unit + FStar_Tactics_V2_Basic.set_dump_on_failure + FStar_Tactics_V2_Basic.set_dump_on_failure in + let uu___137 + = + let uu___138 + = + FStar_Tactics_InterpFuns.mk_tac_step_1 + Prims.int_one "t_commute_applied_match" FStar_Syntax_Embeddings.e_unit FStar_Syntax_Embeddings.e_unit @@ -1004,9 +1017,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_unit FStar_Tactics_V2_Basic.t_commute_applied_match FStar_Tactics_V2_Basic.t_commute_applied_match in - let uu___137 + let uu___139 = - let uu___138 + let uu___140 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1017,9 +1030,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_unit FStar_Tactics_V2_Basic.gather_explicit_guards_for_resolved_goals FStar_Tactics_V2_Basic.gather_explicit_guards_for_resolved_goals in - let uu___139 + let uu___141 = - let uu___140 + let uu___142 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1032,9 +1045,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Tactics_V2_Basic.string_to_term FStar_Tactics_V2_Basic.string_to_term in - let uu___141 + let uu___143 = - let uu___142 + let uu___144 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1051,9 +1064,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Reflection_V2_NBEEmbeddings.e_binding) FStar_Tactics_V2_Basic.push_bv_dsenv FStar_Tactics_V2_Basic.push_bv_dsenv in - let uu___143 + let uu___145 = - let uu___144 + let uu___146 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1064,9 +1077,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_string FStar_Tactics_V2_Basic.term_to_string FStar_Tactics_V2_Basic.term_to_string in - let uu___145 + let uu___147 = - let uu___146 + let uu___148 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1077,9 +1090,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_string FStar_Tactics_V2_Basic.comp_to_string FStar_Tactics_V2_Basic.comp_to_string in - let uu___147 + let uu___149 = - let uu___148 + let uu___150 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1090,9 +1103,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_document FStar_Tactics_V2_Basic.term_to_doc FStar_Tactics_V2_Basic.term_to_doc in - let uu___149 + let uu___151 = - let uu___150 + let uu___152 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1103,9 +1116,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_document FStar_Tactics_V2_Basic.comp_to_doc FStar_Tactics_V2_Basic.comp_to_doc in - let uu___151 + let uu___153 = - let uu___152 + let uu___154 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1116,9 +1129,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_string FStar_Tactics_V2_Basic.range_to_string FStar_Tactics_V2_Basic.range_to_string in - let uu___153 + let uu___155 = - let uu___154 + let uu___156 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1131,15 +1144,15 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_bool FStar_Tactics_V2_Basic.term_eq_old FStar_Tactics_V2_Basic.term_eq_old in - let uu___155 + let uu___157 = - let uu___156 + let uu___158 = - let uu___157 + let uu___159 = FStar_Tactics_Interpreter.e_tactic_thunk FStar_Syntax_Embeddings.e_any in - let uu___158 + let uu___160 = FStar_Tactics_Interpreter.e_tactic_nbe_thunk FStar_TypeChecker_NBETerm.e_any in @@ -1148,23 +1161,23 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = "with_compat_pre_core" FStar_Syntax_Embeddings.e_any FStar_Syntax_Embeddings.e_int - uu___157 + uu___159 FStar_Syntax_Embeddings.e_any FStar_TypeChecker_NBETerm.e_any FStar_TypeChecker_NBETerm.e_int - uu___158 + uu___160 FStar_TypeChecker_NBETerm.e_any (fun - uu___159 + uu___161 -> FStar_Tactics_V2_Basic.with_compat_pre_core) (fun - uu___159 + uu___161 -> FStar_Tactics_V2_Basic.with_compat_pre_core) in - let uu___157 + let uu___159 = - let uu___158 + let uu___160 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1175,9 +1188,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_vconfig FStar_Tactics_V2_Basic.get_vconfig FStar_Tactics_V2_Basic.get_vconfig in - let uu___159 + let uu___161 = - let uu___160 + let uu___162 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1188,9 +1201,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_unit FStar_Tactics_V2_Basic.set_vconfig FStar_Tactics_V2_Basic.set_vconfig in - let uu___161 + let uu___163 = - let uu___162 + let uu___164 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1201,9 +1214,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_unit FStar_Tactics_V2_Basic.t_smt_sync FStar_Tactics_V2_Basic.t_smt_sync in - let uu___163 + let uu___165 = - let uu___164 + let uu___166 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1216,9 +1229,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_int) FStar_Tactics_V2_Basic.free_uvars FStar_Tactics_V2_Basic.free_uvars in - let uu___165 + let uu___167 = - let uu___166 + let uu___168 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1235,9 +1248,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_string)) FStar_Tactics_V2_Basic.all_ext_options FStar_Tactics_V2_Basic.all_ext_options in - let uu___167 + let uu___169 = - let uu___168 + let uu___170 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1248,9 +1261,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_string FStar_Tactics_V2_Basic.ext_getv FStar_Tactics_V2_Basic.ext_getv in - let uu___169 + let uu___171 = - let uu___170 + let uu___172 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1267,9 +1280,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_string)) FStar_Tactics_V2_Basic.ext_getns FStar_Tactics_V2_Basic.ext_getns in - let uu___171 + let uu___173 = - let uu___172 + let uu___174 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_one @@ -1283,16 +1296,16 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = (FStar_Tactics_Embedding.e_tref_nbe ()) (fun - uu___173 + uu___175 -> FStar_Tactics_V2_Basic.alloc) (fun - uu___173 + uu___175 -> FStar_Tactics_V2_Basic.alloc) in - let uu___173 + let uu___175 = - let uu___174 + let uu___176 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_one @@ -1306,16 +1319,16 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = ()) FStar_TypeChecker_NBETerm.e_any (fun - uu___175 + uu___177 -> FStar_Tactics_V2_Basic.read) (fun - uu___175 + uu___177 -> FStar_Tactics_V2_Basic.read) in - let uu___175 + let uu___177 = - let uu___176 + let uu___178 = FStar_Tactics_InterpFuns.mk_tac_step_3 Prims.int_one @@ -1331,16 +1344,16 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_any FStar_TypeChecker_NBETerm.e_unit (fun - uu___177 + uu___179 -> FStar_Tactics_V2_Basic.write) (fun - uu___177 + uu___179 -> FStar_Tactics_V2_Basic.write) in - let uu___177 + let uu___179 = - let uu___178 + let uu___180 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1361,9 +1374,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_is_non_informative FStar_Tactics_V2_Basic.refl_is_non_informative in - let uu___179 + let uu___181 = - let uu___180 + let uu___182 = FStar_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero @@ -1386,9 +1399,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_check_subtyping FStar_Tactics_V2_Basic.refl_check_subtyping in - let uu___181 + let uu___183 = - let uu___182 + let uu___184 = FStar_Tactics_InterpFuns.mk_tac_step_5 Prims.int_zero @@ -1415,9 +1428,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.t_refl_check_equiv FStar_Tactics_V2_Basic.t_refl_check_equiv in - let uu___183 + let uu___185 = - let uu___184 + let uu___186 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1442,9 +1455,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_core_compute_term_type FStar_Tactics_V2_Basic.refl_core_compute_term_type in - let uu___185 + let uu___187 = - let uu___186 + let uu___188 = FStar_Tactics_InterpFuns.mk_tac_step_4 Prims.int_zero @@ -1469,9 +1482,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_core_check_term FStar_Tactics_V2_Basic.refl_core_check_term in - let uu___187 + let uu___189 = - let uu___188 + let uu___190 = FStar_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero @@ -1494,9 +1507,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_core_check_term_at_type FStar_Tactics_V2_Basic.refl_core_check_term_at_type in - let uu___189 + let uu___191 = - let uu___190 + let uu___192 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1525,9 +1538,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_tc_term FStar_Tactics_V2_Basic.refl_tc_term in - let uu___191 + let uu___193 = - let uu___192 + let uu___194 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1548,9 +1561,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_universe_of FStar_Tactics_V2_Basic.refl_universe_of in - let uu___193 + let uu___195 = - let uu___194 + let uu___196 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1571,9 +1584,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_check_prop_validity FStar_Tactics_V2_Basic.refl_check_prop_validity in - let uu___195 + let uu___197 = - let uu___196 + let uu___198 = FStar_Tactics_InterpFuns.mk_tac_step_4 Prims.int_zero @@ -1604,11 +1617,11 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Reflection_V2_NBEEmbeddings.e_binding)))) FStar_Tactics_V2_Basic.refl_check_match_complete FStar_Tactics_V2_Basic.refl_check_match_complete in - let uu___197 + let uu___199 = - let uu___198 + let uu___200 = - let uu___199 + let uu___201 = e_ret_t (FStar_Syntax_Embeddings.e_tuple3 @@ -1621,7 +1634,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = uu___2) (solve uu___2)) in - let uu___200 + let uu___202 = nbe_e_ret_t (FStar_TypeChecker_NBETerm.e_tuple3 @@ -1639,24 +1652,24 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = "instantiate_implicits" FStar_Reflection_V2_Embeddings.e_env uu___2 - uu___199 + uu___201 FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute - uu___200 + uu___202 FStar_Tactics_V2_Basic.refl_instantiate_implicits FStar_Tactics_V2_Basic.refl_instantiate_implicits in - let uu___199 + let uu___201 = - let uu___200 + let uu___202 = - let uu___201 + let uu___203 = e_ret_t (FStar_Syntax_Embeddings.e_list (FStar_Syntax_Embeddings.e_tuple2 FStar_Reflection_V2_Embeddings.e_namedv FStar_Reflection_V2_Embeddings.e_term)) in - let uu___202 + let uu___204 = nbe_e_ret_t (FStar_TypeChecker_NBETerm.e_list @@ -1673,7 +1686,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Reflection_V2_Embeddings.e_term)) uu___2 uu___2 - uu___201 + uu___203 FStar_Reflection_V2_NBEEmbeddings.e_env (FStar_TypeChecker_NBETerm.e_list (FStar_TypeChecker_NBETerm.e_tuple2 @@ -1681,12 +1694,12 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Reflection_V2_NBEEmbeddings.e_term)) FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Reflection_V2_NBEEmbeddings.e_attribute - uu___202 + uu___204 FStar_Tactics_V2_Basic.refl_try_unify FStar_Tactics_V2_Basic.refl_try_unify in - let uu___201 + let uu___203 = - let uu___202 + let uu___204 = FStar_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero @@ -1709,9 +1722,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_maybe_relate_after_unfolding FStar_Tactics_V2_Basic.refl_maybe_relate_after_unfolding in - let uu___203 + let uu___205 = - let uu___204 + let uu___206 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1732,9 +1745,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_maybe_unfold_head FStar_Tactics_V2_Basic.refl_maybe_unfold_head in - let uu___205 + let uu___207 = - let uu___206 + let uu___208 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1747,9 +1760,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Tactics_V2_Basic.push_open_namespace FStar_Tactics_V2_Basic.push_open_namespace in - let uu___207 + let uu___209 = - let uu___208 + let uu___210 = FStar_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero @@ -1764,9 +1777,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Tactics_V2_Basic.push_module_abbrev FStar_Tactics_V2_Basic.push_module_abbrev in - let uu___209 + let uu___211 = - let uu___210 + let uu___212 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1787,9 +1800,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Reflection_V2_NBEEmbeddings.e_fv))) FStar_Tactics_V2_Basic.resolve_name FStar_Tactics_V2_Basic.resolve_name in - let uu___211 + let uu___213 = - let uu___212 + let uu___214 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1802,15 +1815,15 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_unit FStar_Tactics_V2_Basic.log_issues FStar_Tactics_V2_Basic.log_issues in - let uu___213 + let uu___215 = - let uu___214 + let uu___216 = - let uu___215 + let uu___217 = FStar_Tactics_Interpreter.e_tactic_thunk FStar_Syntax_Embeddings.e_unit in - let uu___216 + let uu___218 = FStar_Tactics_Interpreter.e_tactic_nbe_thunk FStar_TypeChecker_NBETerm.e_unit in @@ -1818,7 +1831,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "call_subtac" FStar_Reflection_V2_Embeddings.e_env - uu___215 + uu___217 FStar_Reflection_V2_Embeddings.e_universe uu___2 (FStar_Syntax_Embeddings.e_tuple2 @@ -1827,7 +1840,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = (FStar_Syntax_Embeddings.e_list FStar_Syntax_Embeddings.e_issue)) FStar_Reflection_V2_NBEEmbeddings.e_env - uu___216 + uu___218 FStar_Reflection_V2_NBEEmbeddings.e_universe FStar_Reflection_V2_NBEEmbeddings.e_attribute (FStar_TypeChecker_NBETerm.e_tuple2 @@ -1837,7 +1850,10 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.call_subtac FStar_Tactics_V2_Basic.call_subtac in - [uu___214] in + [uu___216] in + uu___214 + :: + uu___215 in uu___212 :: uu___213 in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Quals.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Quals.ml index 9da0d84e52f..af077137589 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Quals.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Quals.ml @@ -597,67 +597,68 @@ let (check_typeclass_instance_attribute : let uu___ = FStar_Syntax_Util.arrow_formals_comp ty in match uu___ with | (uu___1, res) -> - let uu___2 = FStar_Syntax_Util.is_total_comp res in - if uu___2 - then - let t = FStar_Syntax_Util.comp_result res in + ((let uu___3 = + let uu___4 = FStar_Syntax_Util.is_total_comp res in + Prims.op_Negation uu___4 in + if uu___3 + then + let uu___4 = + let uu___5 = + let uu___6 = + FStar_Errors_Msg.text + "Instances are expected to be total." in + let uu___7 = + let uu___8 = + let uu___9 = + FStar_Errors_Msg.text "This instance has effect" in + let uu___10 = + FStar_Class_PP.pp FStar_Ident.pretty_lident + (FStar_Syntax_Util.comp_effect_name res) in + FStar_Pprint.op_Hat_Hat uu___9 uu___10 in + [uu___8] in + uu___6 :: uu___7 in + (FStar_Errors_Codes.Error_UnexpectedTypeclassInstance, + uu___5) in + FStar_Errors.log_issue_doc rng uu___4 + else ()); + (let t = FStar_Syntax_Util.comp_result res in let uu___3 = FStar_Syntax_Util.head_and_args t in - (match uu___3 with - | (head, uu___4) -> - let err uu___5 = - let uu___6 = - let uu___7 = - let uu___8 = - FStar_Errors_Msg.text - "Instances must define instances of `class` types." in - let uu___9 = - let uu___10 = - let uu___11 = FStar_Errors_Msg.text "Type" in - let uu___12 = - let uu___13 = - FStar_Class_PP.pp - FStar_Syntax_Print.pretty_term t in - let uu___14 = - FStar_Errors_Msg.text "is not a class." in - FStar_Pprint.op_Hat_Slash_Hat uu___13 - uu___14 in - FStar_Pprint.op_Hat_Slash_Hat uu___11 uu___12 in - [uu___10] in - uu___8 :: uu___9 in - (FStar_Errors_Codes.Error_UnexpectedTypeclassInstance, - uu___7) in - FStar_Errors.log_issue_doc rng uu___6 in - let uu___5 = - let uu___6 = FStar_Syntax_Util.un_uinst head in - uu___6.FStar_Syntax_Syntax.n in - (match uu___5 with - | FStar_Syntax_Syntax.Tm_fvar fv -> - let uu___6 = - let uu___7 = - FStar_TypeChecker_Env.fv_has_attr env fv - FStar_Parser_Const.tcclass_lid in - Prims.op_Negation uu___7 in - if uu___6 then err () else () - | uu___6 -> err ())) - else - (let uu___4 = - let uu___5 = - let uu___6 = - FStar_Errors_Msg.text - "Instances are expected to be total." in - let uu___7 = - let uu___8 = - let uu___9 = - FStar_Errors_Msg.text "This instance has effect" in - let uu___10 = - FStar_Class_PP.pp FStar_Ident.pretty_lident - (FStar_Syntax_Util.comp_effect_name res) in - FStar_Pprint.op_Hat_Hat uu___9 uu___10 in - [uu___8] in - uu___6 :: uu___7 in - (FStar_Errors_Codes.Error_UnexpectedTypeclassInstance, - uu___5) in - FStar_Errors.log_issue_doc rng uu___4) in + match uu___3 with + | (head, uu___4) -> + let err uu___5 = + let uu___6 = + let uu___7 = + let uu___8 = + FStar_Errors_Msg.text + "Instances must define instances of `class` types." in + let uu___9 = + let uu___10 = + let uu___11 = FStar_Errors_Msg.text "Type" in + let uu___12 = + let uu___13 = + FStar_Class_PP.pp + FStar_Syntax_Print.pretty_term t in + let uu___14 = + FStar_Errors_Msg.text "is not a class." in + FStar_Pprint.op_Hat_Slash_Hat uu___13 uu___14 in + FStar_Pprint.op_Hat_Slash_Hat uu___11 uu___12 in + [uu___10] in + uu___8 :: uu___9 in + (FStar_Errors_Codes.Error_UnexpectedTypeclassInstance, + uu___7) in + FStar_Errors.log_issue_doc rng uu___6 in + let uu___5 = + let uu___6 = FStar_Syntax_Util.un_uinst head in + uu___6.FStar_Syntax_Syntax.n in + (match uu___5 with + | FStar_Syntax_Syntax.Tm_fvar fv -> + let uu___6 = + let uu___7 = + FStar_TypeChecker_Env.fv_has_attr env fv + FStar_Parser_Const.tcclass_lid in + Prims.op_Negation uu___7 in + if uu___6 then err () else () + | uu___6 -> err ()))) in if is_tc_instance then match se.FStar_Syntax_Syntax.sigel with From 9d39962d124814ba7a995af31dc6ec9166281ab9 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Fri, 19 Apr 2024 18:03:10 -0700 Subject: [PATCH 041/239] revise the statement of inversion of data constructor typing to not reference the irrelevant parameters --- .../generated/FStar_SMTEncoding_Encode.ml | 1092 +++++++++-------- src/smtencoding/FStar.SMTEncoding.Encode.fst | 30 +- tests/bug-reports/Bug3186.fst | 3 - tests/bug-reports/BugBoxInjectivity.fst | 45 +- 4 files changed, 634 insertions(+), 536 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index 5f171b1c4b1..8db7327fa61 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -4121,39 +4121,7 @@ let (encode_sig_inductive : FStar_SMTEncoding_Util.mkEq uu___14) vars indices1 - else - (let num_params = - FStar_Compiler_List.length - tps in - let uu___15 = - FStar_Compiler_List.splitAt - num_params vars in - match uu___15 with - | (_var_params, - var_indices) -> - let uu___16 = - FStar_Compiler_List.splitAt - num_params - indices1 in - (match uu___16 - with - | (_i_params, - indices2) -> - FStar_Compiler_List.map2 - (fun v -> - fun a -> - let uu___17 - = - let uu___18 - = - FStar_SMTEncoding_Util.mkFreeV - v in - (uu___18, - a) in - FStar_SMTEncoding_Util.mkEq - uu___17) - var_indices - indices2)) in + else [] in let uu___13 = let uu___14 = let uu___15 = @@ -4669,51 +4637,60 @@ let (encode_datacon : arg_decls) -> let guards_for_parameter orig_arg arg xv = - let fv1 = - match arg.FStar_SMTEncoding_Term.tm - with - | FStar_SMTEncoding_Term.FreeV - fv2 -> fv2 - | uu___17 -> - let uu___18 - = + if + Prims.op_Negation + is_injective_on_tparams1 + then + FStar_SMTEncoding_Util.mkTrue + else + (let fv1 = + match + arg.FStar_SMTEncoding_Term.tm + with + | FStar_SMTEncoding_Term.FreeV + fv2 -> + fv2 + | uu___18 -> let uu___19 = let uu___20 = + let uu___21 + = FStar_Syntax_Print.term_to_string orig_arg in FStar_Compiler_Util.format1 "Inductive type parameter %s must be a variable ; You may want to change it to an index." - uu___20 in + uu___21 in (FStar_Errors_Codes.Fatal_NonVariableInductiveTypeParameter, - uu___19) in - FStar_Errors.raise_error - uu___18 + uu___20) in + FStar_Errors.raise_error + uu___19 orig_arg.FStar_Syntax_Syntax.pos in - let guards1 = - FStar_Compiler_List.collect - (fun g -> - let uu___17 - = + let guards1 = + FStar_Compiler_List.collect + (fun g -> let uu___18 = + let uu___19 + = FStar_SMTEncoding_Term.free_variables g in FStar_Compiler_List.contains fv1 - uu___18 in - if uu___17 - then - let uu___18 + uu___19 in + if + uu___18 + then + let uu___19 = FStar_SMTEncoding_Term.subst g fv1 xv in - [uu___18] - else []) - guards in - FStar_SMTEncoding_Util.mk_and_l - guards1 in + [uu___19] + else []) + guards in + FStar_SMTEncoding_Util.mk_and_l + guards1) in let uu___17 = let uu___18 = FStar_Compiler_List.zip @@ -4790,101 +4767,142 @@ let (encode_datacon : = FStar_Compiler_List.rev arg_vars in - let ty = - FStar_SMTEncoding_EncodeTerm.maybe_curry_fvb - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.p - encoded_head_fvb + let uu___20 = + FStar_Compiler_List.splitAt + n_tps arg_vars1 in - let xvars1 = - FStar_Compiler_List.map - FStar_SMTEncoding_Util.mkFreeV - vars in - let dapp1 = - FStar_SMTEncoding_Util.mkApp - (ddconstrsym, + (match uu___20 + with + | (arg_params, + uu___21) + -> + let uu___22 + = + FStar_Compiler_List.splitAt + n_tps + vars in + (match uu___22 + with + | + (data_arg_params, + uu___23) + -> + let elim_eqns_and_guards + = + let uu___24 + = + FStar_SMTEncoding_Util.mk_and_l + (FStar_Compiler_List.op_At + elim_eqns_or_guards + guards) in + FStar_Compiler_List.fold_left2 + (fun + elim_eqns_and_guards1 + -> + fun + data_arg_param + -> + fun + arg_param + -> + FStar_SMTEncoding_Term.subst + elim_eqns_and_guards1 + data_arg_param + arg_param) + uu___24 + data_arg_params + arg_params in + let ty = + FStar_SMTEncoding_EncodeTerm.maybe_curry_fvb + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.p + encoded_head_fvb + arg_vars1 in + let xvars1 + = + FStar_Compiler_List.map + FStar_SMTEncoding_Util.mkFreeV + vars in + let dapp1 + = + FStar_SMTEncoding_Util.mkApp + (ddconstrsym, xvars1) in - let ty_pred = - FStar_SMTEncoding_Term.mk_HasTypeWithFuel - (FStar_Pervasives_Native.Some + let ty_pred + = + FStar_SMTEncoding_Term.mk_HasTypeWithFuel + (FStar_Pervasives_Native.Some s_fuel_tm) - dapp1 ty in - let arg_binders - = - FStar_Compiler_List.map - FStar_SMTEncoding_Term.fv_of_term - arg_vars1 in - let typing_inversion - = - let uu___20 - = - let uu___21 + dapp1 ty in + let arg_binders = - let uu___22 + FStar_Compiler_List.map + FStar_SMTEncoding_Term.fv_of_term + arg_vars1 in + let typing_inversion + = + let uu___24 + = + let uu___25 + = + let uu___26 = FStar_Ident.range_of_lid d in - let uu___23 + let uu___27 = - let uu___24 + let uu___28 = - let uu___25 + let uu___29 = FStar_SMTEncoding_Term.mk_fv (fuel_var, FStar_SMTEncoding_Term.Fuel_sort) in FStar_SMTEncoding_Env.add_fuel - uu___25 + uu___29 (FStar_Compiler_List.op_At vars arg_binders) in - let uu___25 - = - let uu___26 - = - let uu___27 + let uu___29 = - FStar_SMTEncoding_Util.mk_and_l - (FStar_Compiler_List.op_At - elim_eqns_or_guards - guards) in - (ty_pred, - uu___27) in FStar_SMTEncoding_Util.mkImp - uu___26 in + (ty_pred, + elim_eqns_and_guards) in ([ [ty_pred]], - uu___24, - uu___25) in + uu___28, + uu___29) in FStar_SMTEncoding_Term.mkForall - uu___22 - uu___23 in - (uu___21, + uu___26 + uu___27 in + (uu___25, (FStar_Pervasives_Native.Some "data constructor typing elim"), (Prims.strcat "data_elim_" ddconstrsym)) in - FStar_SMTEncoding_Util.mkAssume - uu___20 in - let lex_t = - let uu___20 - = - let uu___21 + FStar_SMTEncoding_Util.mkAssume + uu___24 in + let lex_t = - let uu___22 + let uu___24 + = + let uu___25 + = + let uu___26 = FStar_Ident.string_of_lid FStar_Parser_Const.lex_t_lid in - (uu___22, + (uu___26, FStar_SMTEncoding_Term.Term_sort) in - FStar_SMTEncoding_Term.mk_fv - uu___21 in - FStar_SMTEncoding_Util.mkFreeV - uu___20 in - let subterm_ordering - = - let prec = - let uu___20 + FStar_SMTEncoding_Term.mk_fv + uu___25 in + FStar_SMTEncoding_Util.mkFreeV + uu___24 in + let subterm_ordering + = + let prec + = + let uu___24 = FStar_Compiler_List.mapi (fun i -> @@ -4893,90 +4911,92 @@ let (encode_datacon : i < n_tps then [] else - (let uu___22 + (let uu___26 = - let uu___23 + let uu___27 = FStar_SMTEncoding_Util.mkFreeV v in FStar_SMTEncoding_Util.mk_Precedes lex_t lex_t - uu___23 + uu___27 dapp1 in - [uu___22])) + [uu___26])) vars in - FStar_Compiler_List.flatten - uu___20 in - let uu___20 - = - let uu___21 + FStar_Compiler_List.flatten + uu___24 in + let uu___24 = - let uu___22 + let uu___25 + = + let uu___26 = FStar_Ident.range_of_lid d in - let uu___23 + let uu___27 = - let uu___24 + let uu___28 = - let uu___25 + let uu___29 = FStar_SMTEncoding_Term.mk_fv (fuel_var, FStar_SMTEncoding_Term.Fuel_sort) in FStar_SMTEncoding_Env.add_fuel - uu___25 + uu___29 (FStar_Compiler_List.op_At vars arg_binders) in - let uu___25 + let uu___29 = - let uu___26 + let uu___30 = - let uu___27 + let uu___31 = FStar_SMTEncoding_Util.mk_and_l prec in (ty_pred, - uu___27) in + uu___31) in FStar_SMTEncoding_Util.mkImp - uu___26 in + uu___30 in ([ [ty_pred]], - uu___24, - uu___25) in + uu___28, + uu___29) in FStar_SMTEncoding_Term.mkForall - uu___22 - uu___23 in - (uu___21, + uu___26 + uu___27 in + (uu___25, (FStar_Pervasives_Native.Some "subterm ordering"), (Prims.strcat "subterm_ordering_" ddconstrsym)) in - FStar_SMTEncoding_Util.mkAssume - uu___20 in - let uu___20 = - let uu___21 - = - FStar_Compiler_Util.first_N + FStar_SMTEncoding_Util.mkAssume + uu___24 in + let uu___24 + = + let uu___25 + = + FStar_Compiler_Util.first_N n_tps formals in - match uu___21 - with - | (uu___22, + match uu___25 + with + | + (uu___26, formals') -> - let uu___23 + let uu___27 = FStar_Compiler_Util.first_N n_tps vars in - (match uu___23 + (match uu___27 with | - (uu___24, + (uu___28, vars') -> let norm t2 = @@ -4989,26 +5009,26 @@ let (encode_datacon : env'.FStar_SMTEncoding_Env.tcenv t2 in let warn_compat - uu___25 = - let uu___26 + uu___29 = + let uu___30 = FStar_Syntax_Syntax.range_of_fv fv in FStar_Errors.log_issue - uu___26 + uu___30 (FStar_Errors_Codes.Warning_DeprecatedGeneric, "Using 'compat:2954' to use a permissive encoding of the subterm ordering on the codomain of a constructor.\nThis is deprecated and will be removed in a future version of F*.") in - let uu___25 + let uu___29 = FStar_Compiler_List.fold_left2 (fun - uu___26 + uu___30 -> fun formal -> fun var -> - match uu___26 + match uu___30 with | (codomain_prec_l, @@ -5019,28 +5039,28 @@ let (encode_datacon : let t3 = FStar_Syntax_Util.unrefine t2 in - let uu___27 + let uu___31 = - let uu___28 + let uu___32 = FStar_Syntax_Subst.compress t3 in - uu___28.FStar_Syntax_Syntax.n in - match uu___27 + uu___32.FStar_Syntax_Syntax.n in + match uu___31 with | FStar_Syntax_Syntax.Tm_arrow - uu___28 + uu___32 -> - let uu___29 + let uu___33 = - let uu___30 + let uu___34 = FStar_Syntax_Util.unrefine t3 in FStar_Syntax_Util.arrow_formals_comp - uu___30 in - (match uu___29 + uu___34 in + (match uu___33 with | (bs, c) @@ -5051,25 +5071,25 @@ let (encode_datacon : [] -> FStar_Pervasives_Native.None | - uu___30 + uu___34 when - let uu___31 + let uu___35 = FStar_Syntax_Util.is_tot_or_gtot_comp c in Prims.op_Negation - uu___31 + uu___35 -> FStar_Pervasives_Native.None | - uu___30 + uu___34 -> - let uu___31 + let uu___35 = FStar_Syntax_Util.is_lemma_comp c in if - uu___31 + uu___35 then FStar_Pervasives_Native.None else @@ -5079,61 +5099,61 @@ let (encode_datacon : c) in let t5 = norm t4 in - let uu___33 + let uu___37 = (FStar_Syntax_Syntax.is_type t5) || (FStar_Syntax_Util.is_sub_singleton t5) in if - uu___33 + uu___37 then FStar_Pervasives_Native.None else - (let uu___35 + (let uu___39 = FStar_Syntax_Util.head_and_args_full t5 in - match uu___35 + match uu___39 with | (head1, - uu___36) + uu___40) -> - let uu___37 + let uu___41 = - let uu___38 + let uu___42 = FStar_Syntax_Util.un_uinst head1 in - uu___38.FStar_Syntax_Syntax.n in - (match uu___37 + uu___42.FStar_Syntax_Syntax.n in + (match uu___41 with | FStar_Syntax_Syntax.Tm_fvar fv1 -> - let uu___38 + let uu___42 = FStar_Compiler_Util.for_some (FStar_Syntax_Syntax.fv_eq_lid fv1) mutuals in if - uu___38 + uu___42 then FStar_Pervasives_Native.Some (bs, c) else - (let uu___40 + (let uu___44 = - let uu___41 + let uu___45 = FStar_Options.ext_getv "compat:2954" in - uu___41 + uu___45 <> "" in if - uu___40 + uu___44 then (warn_compat (); @@ -5142,18 +5162,18 @@ let (encode_datacon : else FStar_Pervasives_Native.None) | - uu___38 + uu___42 -> - let uu___39 + let uu___43 = - let uu___40 + let uu___44 = FStar_Options.ext_getv "compat:2954" in - uu___40 + uu___44 <> "" in if - uu___39 + uu___43 then (warn_compat (); @@ -5162,36 +5182,36 @@ let (encode_datacon : else FStar_Pervasives_Native.None))))) | - uu___28 + uu___32 -> - let uu___29 + let uu___33 = FStar_Syntax_Util.head_and_args t3 in - (match uu___29 + (match uu___33 with | (head1, - uu___30) + uu___34) -> let t' = norm t3 in - let uu___31 + let uu___35 = FStar_Syntax_Util.head_and_args t' in - (match uu___31 + (match uu___35 with | (head', - uu___32) + uu___36) -> - let uu___33 + let uu___37 = FStar_Syntax_Util.eq_tm head1 head' in - (match uu___33 + (match uu___37 with | FStar_Syntax_Util.Equal @@ -5203,44 +5223,44 @@ let (encode_datacon : binder_and_codomain_type t' | - uu___34 + uu___38 -> - let uu___35 + let uu___39 = - let uu___36 + let uu___40 = FStar_Syntax_Subst.compress head1 in - uu___36.FStar_Syntax_Syntax.n in - (match uu___35 + uu___40.FStar_Syntax_Syntax.n in + (match uu___39 with | FStar_Syntax_Syntax.Tm_fvar - uu___36 + uu___40 -> binder_and_codomain_type t' | FStar_Syntax_Syntax.Tm_name - uu___36 + uu___40 -> binder_and_codomain_type t' | FStar_Syntax_Syntax.Tm_uinst - uu___36 + uu___40 -> binder_and_codomain_type t' | - uu___36 + uu___40 -> FStar_Pervasives_Native.None)))) in - let uu___27 + let uu___31 = binder_and_codomain_type (formal.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in - (match uu___27 + (match uu___31 with | FStar_Pervasives_Native.None @@ -5251,90 +5271,90 @@ let (encode_datacon : FStar_Pervasives_Native.Some (bs, c) -> - let uu___28 + let uu___32 = FStar_SMTEncoding_EncodeTerm.encode_binders FStar_Pervasives_Native.None bs env' in - (match uu___28 + (match uu___32 with | (bs', guards', _env', bs_decls, - uu___29) + uu___33) -> let fun_app = - let uu___30 + let uu___34 = FStar_SMTEncoding_Util.mkFreeV var in FStar_SMTEncoding_EncodeTerm.mk_Apply - uu___30 + uu___34 bs' in - let uu___30 + let uu___34 = - let uu___31 + let uu___35 = - let uu___32 + let uu___36 = FStar_Ident.range_of_lid d in - let uu___33 + let uu___37 = - let uu___34 + let uu___38 = - let uu___35 + let uu___39 = - let uu___36 + let uu___40 = FStar_SMTEncoding_Util.mk_Precedes lex_t lex_t fun_app dapp1 in - [uu___36] in - [uu___35] in - let uu___35 + [uu___40] in + [uu___39] in + let uu___39 = - let uu___36 + let uu___40 = - let uu___37 + let uu___41 = FStar_SMTEncoding_Util.mk_and_l (ty_pred' :: guards') in - let uu___38 + let uu___42 = FStar_SMTEncoding_Util.mk_Precedes lex_t lex_t fun_app dapp1 in - (uu___37, - uu___38) in + (uu___41, + uu___42) in FStar_SMTEncoding_Util.mkImp - uu___36 in - (uu___34, + uu___40 in + (uu___38, bs', - uu___35) in + uu___39) in FStar_SMTEncoding_Term.mkForall - uu___32 - uu___33 in - uu___31 + uu___36 + uu___37 in + uu___35 :: codomain_prec_l in - (uu___30, + (uu___34, (FStar_Compiler_List.op_At bs_decls cod_decls))))) ([], []) formals' vars' in - (match uu___25 + (match uu___29 with | (codomain_prec_l, @@ -5347,60 +5367,61 @@ let (encode_datacon : ([], cod_decls) | - uu___26 + uu___30 -> - let uu___27 + let uu___31 = - let uu___28 + let uu___32 = - let uu___29 + let uu___33 = - let uu___30 + let uu___34 = - let uu___31 + let uu___35 = FStar_Ident.range_of_lid d in - let uu___32 + let uu___36 = - let uu___33 + let uu___37 = - let uu___34 + let uu___38 = FStar_SMTEncoding_Term.mk_fv (fuel_var, FStar_SMTEncoding_Term.Fuel_sort) in FStar_SMTEncoding_Env.add_fuel - uu___34 + uu___38 (FStar_Compiler_List.op_At vars arg_binders) in - let uu___34 + let uu___38 = FStar_SMTEncoding_Util.mk_and_l codomain_prec_l in ([ [ty_pred]], - uu___33, - uu___34) in + uu___37, + uu___38) in FStar_SMTEncoding_Term.mkForall - uu___31 - uu___32 in - (uu___30, + uu___35 + uu___36 in + (uu___34, (FStar_Pervasives_Native.Some "well-founded ordering on codomain"), (Prims.strcat "well_founded_ordering_on_codomain_" ddconstrsym)) in FStar_SMTEncoding_Util.mkAssume - uu___29 in - [uu___28] in - (uu___27, + uu___33 in + [uu___32] in + (uu___31, cod_decls)))) in - (match uu___20 - with - | (codomain_ordering, - codomain_decls) + (match uu___24 + with + | + (codomain_ordering, + codomain_decls) -> ((FStar_Compiler_List.op_At arg_decls @@ -5408,7 +5429,7 @@ let (encode_datacon : (FStar_Compiler_List.op_At [typing_inversion; subterm_ordering] - codomain_ordering))))) + codomain_ordering))))))) | FStar_Syntax_Syntax.Tm_fvar fv -> let encoded_head_fvb = @@ -5423,51 +5444,60 @@ let (encode_datacon : arg_decls) -> let guards_for_parameter orig_arg arg xv = - let fv1 = - match arg.FStar_SMTEncoding_Term.tm - with - | FStar_SMTEncoding_Term.FreeV - fv2 -> fv2 - | uu___13 -> - let uu___14 - = + if + Prims.op_Negation + is_injective_on_tparams1 + then + FStar_SMTEncoding_Util.mkTrue + else + (let fv1 = + match + arg.FStar_SMTEncoding_Term.tm + with + | FStar_SMTEncoding_Term.FreeV + fv2 -> + fv2 + | uu___14 -> let uu___15 = let uu___16 = + let uu___17 + = FStar_Syntax_Print.term_to_string orig_arg in FStar_Compiler_Util.format1 "Inductive type parameter %s must be a variable ; You may want to change it to an index." - uu___16 in + uu___17 in (FStar_Errors_Codes.Fatal_NonVariableInductiveTypeParameter, - uu___15) in - FStar_Errors.raise_error - uu___14 + uu___16) in + FStar_Errors.raise_error + uu___15 orig_arg.FStar_Syntax_Syntax.pos in - let guards1 = - FStar_Compiler_List.collect - (fun g -> - let uu___13 - = + let guards1 = + FStar_Compiler_List.collect + (fun g -> let uu___14 = + let uu___15 + = FStar_SMTEncoding_Term.free_variables g in FStar_Compiler_List.contains fv1 - uu___14 in - if uu___13 - then - let uu___14 + uu___15 in + if + uu___14 + then + let uu___15 = FStar_SMTEncoding_Term.subst g fv1 xv in - [uu___14] - else []) - guards in - FStar_SMTEncoding_Util.mk_and_l - guards1 in + [uu___15] + else []) + guards in + FStar_SMTEncoding_Util.mk_and_l + guards1) in let uu___13 = let uu___14 = FStar_Compiler_List.zip @@ -5544,101 +5574,142 @@ let (encode_datacon : = FStar_Compiler_List.rev arg_vars in - let ty = - FStar_SMTEncoding_EncodeTerm.maybe_curry_fvb - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.p - encoded_head_fvb + let uu___16 = + FStar_Compiler_List.splitAt + n_tps arg_vars1 in - let xvars1 = - FStar_Compiler_List.map - FStar_SMTEncoding_Util.mkFreeV - vars in - let dapp1 = - FStar_SMTEncoding_Util.mkApp - (ddconstrsym, + (match uu___16 + with + | (arg_params, + uu___17) + -> + let uu___18 + = + FStar_Compiler_List.splitAt + n_tps + vars in + (match uu___18 + with + | + (data_arg_params, + uu___19) + -> + let elim_eqns_and_guards + = + let uu___20 + = + FStar_SMTEncoding_Util.mk_and_l + (FStar_Compiler_List.op_At + elim_eqns_or_guards + guards) in + FStar_Compiler_List.fold_left2 + (fun + elim_eqns_and_guards1 + -> + fun + data_arg_param + -> + fun + arg_param + -> + FStar_SMTEncoding_Term.subst + elim_eqns_and_guards1 + data_arg_param + arg_param) + uu___20 + data_arg_params + arg_params in + let ty = + FStar_SMTEncoding_EncodeTerm.maybe_curry_fvb + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.p + encoded_head_fvb + arg_vars1 in + let xvars1 + = + FStar_Compiler_List.map + FStar_SMTEncoding_Util.mkFreeV + vars in + let dapp1 + = + FStar_SMTEncoding_Util.mkApp + (ddconstrsym, xvars1) in - let ty_pred = - FStar_SMTEncoding_Term.mk_HasTypeWithFuel - (FStar_Pervasives_Native.Some + let ty_pred + = + FStar_SMTEncoding_Term.mk_HasTypeWithFuel + (FStar_Pervasives_Native.Some s_fuel_tm) - dapp1 ty in - let arg_binders - = - FStar_Compiler_List.map - FStar_SMTEncoding_Term.fv_of_term - arg_vars1 in - let typing_inversion - = - let uu___16 - = - let uu___17 + dapp1 ty in + let arg_binders = - let uu___18 + FStar_Compiler_List.map + FStar_SMTEncoding_Term.fv_of_term + arg_vars1 in + let typing_inversion + = + let uu___20 + = + let uu___21 + = + let uu___22 = FStar_Ident.range_of_lid d in - let uu___19 + let uu___23 = - let uu___20 + let uu___24 = - let uu___21 + let uu___25 = FStar_SMTEncoding_Term.mk_fv (fuel_var, FStar_SMTEncoding_Term.Fuel_sort) in FStar_SMTEncoding_Env.add_fuel - uu___21 + uu___25 (FStar_Compiler_List.op_At vars arg_binders) in - let uu___21 - = - let uu___22 - = - let uu___23 + let uu___25 = - FStar_SMTEncoding_Util.mk_and_l - (FStar_Compiler_List.op_At - elim_eqns_or_guards - guards) in - (ty_pred, - uu___23) in FStar_SMTEncoding_Util.mkImp - uu___22 in + (ty_pred, + elim_eqns_and_guards) in ([ [ty_pred]], - uu___20, - uu___21) in + uu___24, + uu___25) in FStar_SMTEncoding_Term.mkForall - uu___18 - uu___19 in - (uu___17, + uu___22 + uu___23 in + (uu___21, (FStar_Pervasives_Native.Some "data constructor typing elim"), (Prims.strcat "data_elim_" ddconstrsym)) in - FStar_SMTEncoding_Util.mkAssume - uu___16 in - let lex_t = - let uu___16 - = - let uu___17 + FStar_SMTEncoding_Util.mkAssume + uu___20 in + let lex_t = - let uu___18 + let uu___20 + = + let uu___21 + = + let uu___22 = FStar_Ident.string_of_lid FStar_Parser_Const.lex_t_lid in - (uu___18, + (uu___22, FStar_SMTEncoding_Term.Term_sort) in - FStar_SMTEncoding_Term.mk_fv - uu___17 in - FStar_SMTEncoding_Util.mkFreeV - uu___16 in - let subterm_ordering - = - let prec = - let uu___16 + FStar_SMTEncoding_Term.mk_fv + uu___21 in + FStar_SMTEncoding_Util.mkFreeV + uu___20 in + let subterm_ordering + = + let prec + = + let uu___20 = FStar_Compiler_List.mapi (fun i -> @@ -5647,90 +5718,92 @@ let (encode_datacon : i < n_tps then [] else - (let uu___18 + (let uu___22 = - let uu___19 + let uu___23 = FStar_SMTEncoding_Util.mkFreeV v in FStar_SMTEncoding_Util.mk_Precedes lex_t lex_t - uu___19 + uu___23 dapp1 in - [uu___18])) + [uu___22])) vars in - FStar_Compiler_List.flatten - uu___16 in - let uu___16 - = - let uu___17 + FStar_Compiler_List.flatten + uu___20 in + let uu___20 = - let uu___18 + let uu___21 + = + let uu___22 = FStar_Ident.range_of_lid d in - let uu___19 + let uu___23 = - let uu___20 + let uu___24 = - let uu___21 + let uu___25 = FStar_SMTEncoding_Term.mk_fv (fuel_var, FStar_SMTEncoding_Term.Fuel_sort) in FStar_SMTEncoding_Env.add_fuel - uu___21 + uu___25 (FStar_Compiler_List.op_At vars arg_binders) in - let uu___21 + let uu___25 = - let uu___22 + let uu___26 = - let uu___23 + let uu___27 = FStar_SMTEncoding_Util.mk_and_l prec in (ty_pred, - uu___23) in + uu___27) in FStar_SMTEncoding_Util.mkImp - uu___22 in + uu___26 in ([ [ty_pred]], - uu___20, - uu___21) in + uu___24, + uu___25) in FStar_SMTEncoding_Term.mkForall - uu___18 - uu___19 in - (uu___17, + uu___22 + uu___23 in + (uu___21, (FStar_Pervasives_Native.Some "subterm ordering"), (Prims.strcat "subterm_ordering_" ddconstrsym)) in - FStar_SMTEncoding_Util.mkAssume - uu___16 in - let uu___16 = - let uu___17 - = - FStar_Compiler_Util.first_N + FStar_SMTEncoding_Util.mkAssume + uu___20 in + let uu___20 + = + let uu___21 + = + FStar_Compiler_Util.first_N n_tps formals in - match uu___17 - with - | (uu___18, + match uu___21 + with + | + (uu___22, formals') -> - let uu___19 + let uu___23 = FStar_Compiler_Util.first_N n_tps vars in - (match uu___19 + (match uu___23 with | - (uu___20, + (uu___24, vars') -> let norm t2 = @@ -5743,26 +5816,26 @@ let (encode_datacon : env'.FStar_SMTEncoding_Env.tcenv t2 in let warn_compat - uu___21 = - let uu___22 + uu___25 = + let uu___26 = FStar_Syntax_Syntax.range_of_fv fv in FStar_Errors.log_issue - uu___22 + uu___26 (FStar_Errors_Codes.Warning_DeprecatedGeneric, "Using 'compat:2954' to use a permissive encoding of the subterm ordering on the codomain of a constructor.\nThis is deprecated and will be removed in a future version of F*.") in - let uu___21 + let uu___25 = FStar_Compiler_List.fold_left2 (fun - uu___22 + uu___26 -> fun formal -> fun var -> - match uu___22 + match uu___26 with | (codomain_prec_l, @@ -5773,28 +5846,28 @@ let (encode_datacon : let t3 = FStar_Syntax_Util.unrefine t2 in - let uu___23 + let uu___27 = - let uu___24 + let uu___28 = FStar_Syntax_Subst.compress t3 in - uu___24.FStar_Syntax_Syntax.n in - match uu___23 + uu___28.FStar_Syntax_Syntax.n in + match uu___27 with | FStar_Syntax_Syntax.Tm_arrow - uu___24 + uu___28 -> - let uu___25 + let uu___29 = - let uu___26 + let uu___30 = FStar_Syntax_Util.unrefine t3 in FStar_Syntax_Util.arrow_formals_comp - uu___26 in - (match uu___25 + uu___30 in + (match uu___29 with | (bs, c) @@ -5805,25 +5878,25 @@ let (encode_datacon : [] -> FStar_Pervasives_Native.None | - uu___26 + uu___30 when - let uu___27 + let uu___31 = FStar_Syntax_Util.is_tot_or_gtot_comp c in Prims.op_Negation - uu___27 + uu___31 -> FStar_Pervasives_Native.None | - uu___26 + uu___30 -> - let uu___27 + let uu___31 = FStar_Syntax_Util.is_lemma_comp c in if - uu___27 + uu___31 then FStar_Pervasives_Native.None else @@ -5833,61 +5906,61 @@ let (encode_datacon : c) in let t5 = norm t4 in - let uu___29 + let uu___33 = (FStar_Syntax_Syntax.is_type t5) || (FStar_Syntax_Util.is_sub_singleton t5) in if - uu___29 + uu___33 then FStar_Pervasives_Native.None else - (let uu___31 + (let uu___35 = FStar_Syntax_Util.head_and_args_full t5 in - match uu___31 + match uu___35 with | (head1, - uu___32) + uu___36) -> - let uu___33 + let uu___37 = - let uu___34 + let uu___38 = FStar_Syntax_Util.un_uinst head1 in - uu___34.FStar_Syntax_Syntax.n in - (match uu___33 + uu___38.FStar_Syntax_Syntax.n in + (match uu___37 with | FStar_Syntax_Syntax.Tm_fvar fv1 -> - let uu___34 + let uu___38 = FStar_Compiler_Util.for_some (FStar_Syntax_Syntax.fv_eq_lid fv1) mutuals in if - uu___34 + uu___38 then FStar_Pervasives_Native.Some (bs, c) else - (let uu___36 + (let uu___40 = - let uu___37 + let uu___41 = FStar_Options.ext_getv "compat:2954" in - uu___37 + uu___41 <> "" in if - uu___36 + uu___40 then (warn_compat (); @@ -5896,18 +5969,18 @@ let (encode_datacon : else FStar_Pervasives_Native.None) | - uu___34 + uu___38 -> - let uu___35 + let uu___39 = - let uu___36 + let uu___40 = FStar_Options.ext_getv "compat:2954" in - uu___36 + uu___40 <> "" in if - uu___35 + uu___39 then (warn_compat (); @@ -5916,36 +5989,36 @@ let (encode_datacon : else FStar_Pervasives_Native.None))))) | - uu___24 + uu___28 -> - let uu___25 + let uu___29 = FStar_Syntax_Util.head_and_args t3 in - (match uu___25 + (match uu___29 with | (head1, - uu___26) + uu___30) -> let t' = norm t3 in - let uu___27 + let uu___31 = FStar_Syntax_Util.head_and_args t' in - (match uu___27 + (match uu___31 with | (head', - uu___28) + uu___32) -> - let uu___29 + let uu___33 = FStar_Syntax_Util.eq_tm head1 head' in - (match uu___29 + (match uu___33 with | FStar_Syntax_Util.Equal @@ -5957,44 +6030,44 @@ let (encode_datacon : binder_and_codomain_type t' | - uu___30 + uu___34 -> - let uu___31 + let uu___35 = - let uu___32 + let uu___36 = FStar_Syntax_Subst.compress head1 in - uu___32.FStar_Syntax_Syntax.n in - (match uu___31 + uu___36.FStar_Syntax_Syntax.n in + (match uu___35 with | FStar_Syntax_Syntax.Tm_fvar - uu___32 + uu___36 -> binder_and_codomain_type t' | FStar_Syntax_Syntax.Tm_name - uu___32 + uu___36 -> binder_and_codomain_type t' | FStar_Syntax_Syntax.Tm_uinst - uu___32 + uu___36 -> binder_and_codomain_type t' | - uu___32 + uu___36 -> FStar_Pervasives_Native.None)))) in - let uu___23 + let uu___27 = binder_and_codomain_type (formal.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in - (match uu___23 + (match uu___27 with | FStar_Pervasives_Native.None @@ -6005,90 +6078,90 @@ let (encode_datacon : FStar_Pervasives_Native.Some (bs, c) -> - let uu___24 + let uu___28 = FStar_SMTEncoding_EncodeTerm.encode_binders FStar_Pervasives_Native.None bs env' in - (match uu___24 + (match uu___28 with | (bs', guards', _env', bs_decls, - uu___25) + uu___29) -> let fun_app = - let uu___26 + let uu___30 = FStar_SMTEncoding_Util.mkFreeV var in FStar_SMTEncoding_EncodeTerm.mk_Apply - uu___26 + uu___30 bs' in - let uu___26 + let uu___30 = - let uu___27 + let uu___31 = - let uu___28 + let uu___32 = FStar_Ident.range_of_lid d in - let uu___29 + let uu___33 = - let uu___30 + let uu___34 = - let uu___31 + let uu___35 = - let uu___32 + let uu___36 = FStar_SMTEncoding_Util.mk_Precedes lex_t lex_t fun_app dapp1 in - [uu___32] in - [uu___31] in - let uu___31 + [uu___36] in + [uu___35] in + let uu___35 = - let uu___32 + let uu___36 = - let uu___33 + let uu___37 = FStar_SMTEncoding_Util.mk_and_l (ty_pred' :: guards') in - let uu___34 + let uu___38 = FStar_SMTEncoding_Util.mk_Precedes lex_t lex_t fun_app dapp1 in - (uu___33, - uu___34) in + (uu___37, + uu___38) in FStar_SMTEncoding_Util.mkImp - uu___32 in - (uu___30, + uu___36 in + (uu___34, bs', - uu___31) in + uu___35) in FStar_SMTEncoding_Term.mkForall - uu___28 - uu___29 in - uu___27 + uu___32 + uu___33 in + uu___31 :: codomain_prec_l in - (uu___26, + (uu___30, (FStar_Compiler_List.op_At bs_decls cod_decls))))) ([], []) formals' vars' in - (match uu___21 + (match uu___25 with | (codomain_prec_l, @@ -6101,60 +6174,61 @@ let (encode_datacon : ([], cod_decls) | - uu___22 + uu___26 -> - let uu___23 + let uu___27 = - let uu___24 + let uu___28 = - let uu___25 + let uu___29 = - let uu___26 + let uu___30 = - let uu___27 + let uu___31 = FStar_Ident.range_of_lid d in - let uu___28 + let uu___32 = - let uu___29 + let uu___33 = - let uu___30 + let uu___34 = FStar_SMTEncoding_Term.mk_fv (fuel_var, FStar_SMTEncoding_Term.Fuel_sort) in FStar_SMTEncoding_Env.add_fuel - uu___30 + uu___34 (FStar_Compiler_List.op_At vars arg_binders) in - let uu___30 + let uu___34 = FStar_SMTEncoding_Util.mk_and_l codomain_prec_l in ([ [ty_pred]], - uu___29, - uu___30) in + uu___33, + uu___34) in FStar_SMTEncoding_Term.mkForall - uu___27 - uu___28 in - (uu___26, + uu___31 + uu___32 in + (uu___30, (FStar_Pervasives_Native.Some "well-founded ordering on codomain"), (Prims.strcat "well_founded_ordering_on_codomain_" ddconstrsym)) in FStar_SMTEncoding_Util.mkAssume - uu___25 in - [uu___24] in - (uu___23, + uu___29 in + [uu___28] in + (uu___27, cod_decls)))) in - (match uu___16 - with - | (codomain_ordering, - codomain_decls) + (match uu___20 + with + | + (codomain_ordering, + codomain_decls) -> ((FStar_Compiler_List.op_At arg_decls @@ -6162,7 +6236,7 @@ let (encode_datacon : (FStar_Compiler_List.op_At [typing_inversion; subterm_ordering] - codomain_ordering))))) + codomain_ordering))))))) | uu___12 -> ((let uu___14 = let uu___15 = diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index 7396d59bd8c..5ce63a6c2f3 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -1118,13 +1118,13 @@ let encode_sig_inductive (is_injective_on_params:bool) (env:env_t) (se:sigelt) if is_injective_on_params || Options.ext_getv "compat:injectivity" <> "" then List.map2 (fun v a -> mkEq(mkFreeV v, a)) vars indices - else ( - //only injectivity on indices - let num_params = List.length tps in - let _var_params, var_indices = List.splitAt num_params vars in - let _i_params, indices = List.splitAt num_params indices in - List.map2 (fun v a -> mkEq(mkFreeV v, a)) var_indices indices - ) + else [] + // //only injectivity on indices + // let num_params = List.length tps in + // let _var_params, var_indices = List.splitAt num_params vars in + // let _i_params, indices = List.splitAt num_params indices in + // List.map2 (fun v a -> mkEq(mkFreeV v, a)) var_indices indices + // ) in mkOr(out, mkAnd(mk_data_tester env l xx, eqs |> mk_and_l)), decls@decls') (mkFalse, []) @@ -1290,6 +1290,9 @@ let encode_datacon (is_injective_on_tparams:bool) (env:env_t) (se:sigelt) let encoded_head_fvb = lookup_free_var_name env' fv.fv_name in let encoded_args, arg_decls = encode_args args env' in let guards_for_parameter (orig_arg:S.term)(arg:term) xv = + if not is_injective_on_tparams + then mkTrue + else ( let fv = match arg.tm with | FreeV fv -> fv @@ -1305,6 +1308,7 @@ let encode_datacon (is_injective_on_tparams:bool) (env:env_t) (se:sigelt) else []) in mk_and_l guards + ) in let _, arg_vars, elim_eqns_or_guards, _ = List.fold_left @@ -1322,6 +1326,16 @@ let encode_datacon (is_injective_on_tparams:bool) (env:env_t) (se:sigelt) (FStar.Compiler.List.zip args encoded_args) in let arg_vars = List.rev arg_vars in + let arg_params, _ = List.splitAt n_tps arg_vars in + let data_arg_params, _ = List.splitAt n_tps vars in + let elim_eqns_and_guards = + List.fold_left2 + (fun elim_eqns_and_guards data_arg_param arg_param -> + Term.subst elim_eqns_and_guards data_arg_param arg_param) + (mk_and_l (elim_eqns_or_guards@guards)) + data_arg_params + arg_params + in let ty = maybe_curry_fvb fv.fv_name.p encoded_head_fvb arg_vars in let xvars = List.map mkFreeV vars in let dapp = mkApp(ddconstrsym, xvars) in //arity ok; |xvars| = |formals| = arity @@ -1330,7 +1344,7 @@ let encode_datacon (is_injective_on_tparams:bool) (env:env_t) (se:sigelt) let typing_inversion = Util.mkAssume(mkForall (Ident.range_of_lid d) ([[ty_pred]], add_fuel (mk_fv (fuel_var, Fuel_sort)) (vars@arg_binders), - mkImp(ty_pred, mk_and_l (elim_eqns_or_guards@guards))), + mkImp(ty_pred, elim_eqns_and_guards)), Some "data constructor typing elim", ("data_elim_" ^ ddconstrsym)) in let lex_t = mkFreeV <| mk_fv (string_of_lid Const.lex_t_lid, Term_sort) in diff --git a/tests/bug-reports/Bug3186.fst b/tests/bug-reports/Bug3186.fst index 544473db34a..34b0d9ca191 100644 --- a/tests/bug-reports/Bug3186.fst +++ b/tests/bug-reports/Bug3186.fst @@ -7,9 +7,6 @@ let base2 (x:int) (hyp: equals x 0) = let Refl = hyp in assert (x == 0) - //fails since the inversion on equals is not strong enough - //to be usable directly, since df6fb0d52e52289db625cbdbc7c34d975801d819 -[@@expect_failure [19]] let base2' (x:int) (hyp: equals x 0) = assert (x == 0) diff --git a/tests/bug-reports/BugBoxInjectivity.fst b/tests/bug-reports/BugBoxInjectivity.fst index ebf209f7bdf..c488bfbed1d 100644 --- a/tests/bug-reports/BugBoxInjectivity.fst +++ b/tests/bug-reports/BugBoxInjectivity.fst @@ -1,23 +1,36 @@ module BugBoxInjectivity -open FStar.Functions -module CC = FStar.Cardinality.Universes -type t (a:Type u#1) : Type u#0 = - | Mk : t a +noeq +type ceq (#a:Type) x : a -> Type = + | Refl : ceq #a x x -let inj_t (#a:Type u#1) (x:t a) -: Lemma (x == Mk #a) -= let Mk #_ = x in () +let test a (x y:a) (h:ceq #a x y) : Lemma (x == y) = () + +[@expect_failure] +let bad (h0:ceq true true) (h1:ceq false false) : Lemma (true == false) = + let Refl = h0 in + let Refl = h1 in + () -[@@expect_failure] -let t_injective : squash (is_inj t) = - introduce forall f0 f1. - t f0 == t f1 ==> f0 == f1 - with introduce _ ==> _ - with _ . ( - inj_t #f0 Mk; - inj_t #f1 (coerce_eq () (Mk #f0)) - ) +// open FStar.Functions +// module CC = FStar.Cardinality.Universes + +// type t (a:Type u#1) : Type u#0 = +// | Mk : t a + +// let inj_t (#a:Type u#1) (x:t a) +// : Lemma (x == Mk #a) +// = let Mk #_ = x in () + +// [@@expect_failure] +// let t_injective : squash (is_inj t) = +// introduce forall f0 f1. +// t f0 == t f1 ==> f0 == f1 +// with introduce _ ==> _ +// with _ . ( +// inj_t #f0 Mk; +// inj_t #f1 (coerce_eq () (Mk #f0)) +// ) // #restart-solver From ec1ed9d924a7f38fc35a481d539007d883784ac6 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Fri, 19 Apr 2024 19:01:53 -0700 Subject: [PATCH 042/239] remove projector function altogether if it is not injective --- .../generated/FStar_SMTEncoding_Term.ml | 12 +- src/smtencoding/FStar.SMTEncoding.Term.fst | 11 +- tests/bug-reports/BugBoxInjectivity.fst | 116 ++++++------------ 3 files changed, 51 insertions(+), 88 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml index 63a65a35a73..7066a54054f 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml @@ -1490,13 +1490,13 @@ let (injective_constructor : match uu___2 with | { field_name = name1; field_sort = s; field_projectible = projectible;_} -> - let cproj_app = mkApp (name1, [capp]) norng in - let proj_name = - DeclFun - (name1, [sort1], s, - (FStar_Pervasives_Native.Some "Projector")) in if projectible then + let cproj_app = mkApp (name1, [capp]) norng in + let proj_name = + DeclFun + (name1, [sort1], s, + (FStar_Pervasives_Native.Some "Projector")) in let a = let uu___3 = let uu___4 = @@ -1520,7 +1520,7 @@ let (injective_constructor : assumption_fact_ids = [] } in [proj_name; Assume a] - else [proj_name]) fields in + else []) fields in FStar_Compiler_List.flatten uu___1 let (discriminator_name : constructor_t -> Prims.string) = fun constr -> Prims.strcat "is-" constr.constr_name diff --git a/src/smtencoding/FStar.SMTEncoding.Term.fst b/src/smtencoding/FStar.SMTEncoding.Term.fst index 93ceba286ee..07857606bf2 100644 --- a/src/smtencoding/FStar.SMTEncoding.Term.fst +++ b/src/smtencoding/FStar.SMTEncoding.Term.fst @@ -583,17 +583,18 @@ let injective_constructor let capp = mkApp(name, bvars) norng in fields |> List.mapi (fun i {field_projectible=projectible; field_name=name; field_sort=s} -> - let cproj_app = mkApp(name, [capp]) norng in - let proj_name = DeclFun(name, [sort], s, Some "Projector") in if projectible - then let a = { + then + let cproj_app = mkApp(name, [capp]) norng in + let proj_name = DeclFun(name, [sort], s, Some "Projector") in + let a = { assumption_name = escape ("projection_inverse_"^name); assumption_caption = Some "Projection inverse"; assumption_term = mkForall rng ([[capp]], bvar_names, mkEq(cproj_app, bvar i s norng) norng); assumption_fact_ids = [] } in - [proj_name; Assume a] - else [proj_name]) + [proj_name; Assume a] + else []) |> List.flatten let discriminator_name constr = "is-"^constr.constr_name diff --git a/tests/bug-reports/BugBoxInjectivity.fst b/tests/bug-reports/BugBoxInjectivity.fst index c488bfbed1d..db7f646c1fe 100644 --- a/tests/bug-reports/BugBoxInjectivity.fst +++ b/tests/bug-reports/BugBoxInjectivity.fst @@ -12,85 +12,47 @@ let bad (h0:ceq true true) (h1:ceq false false) : Lemma (true == false) = let Refl = h1 in () -// open FStar.Functions -// module CC = FStar.Cardinality.Universes +open FStar.Functions +module CC = FStar.Cardinality.Universes -// type t (a:Type u#1) : Type u#0 = -// | Mk : t a +type t (a:Type u#1) : Type u#0 = + | Mk : t a -// let inj_t (#a:Type u#1) (x:t a) -// : Lemma (x == Mk #a) -// = let Mk #_ = x in () +let inj_t (#a:Type u#1) (x:t a) +: Lemma (x == Mk #a) += let Mk #_ = x in () -// [@@expect_failure] -// let t_injective : squash (is_inj t) = -// introduce forall f0 f1. -// t f0 == t f1 ==> f0 == f1 -// with introduce _ ==> _ -// with _ . ( -// inj_t #f0 Mk; -// inj_t #f1 (coerce_eq () (Mk #f0)) -// ) +[@@expect_failure] +let t_injective : squash (is_inj t) = + introduce forall f0 f1. + t f0 == t f1 ==> f0 == f1 + with introduce _ ==> _ + with _ . ( + inj_t #f0 Mk; + inj_t #f1 (coerce_eq () (Mk #f0)) + ) -// #restart-solver -// #push-options "--log_queries --query_stats --debug BugBoxInjectivity --debug_level SMTEncoding" -// module CC = FStar.Cardinality.Universes -// noeq -// type test (a:Type u#0 -> Type u#1) : Type u#1 = -// | Mk : test a - -// let const (f:Type u#1) : Type u#0 -> Type u#1 = fun _ -> f -// let itest (f:Type u#1) : Type u#1 = test (const f) -// let itest_inhabited (f:Type u#1) : itest f = Mk -// let const_inversion (f0 f1:Type u#1) -// : Lemma -// (requires const f0 == const f1) -// (ensures f0 == f1) -// = let _f0 = const f0 int in -// let _f1 = const f1 int in -// assert (_f0 == _f1); -// () -// let itest_injective (f0 f1:Type u#1) -// : Lemma -// (ensures itest f0 == itest f1 ==> const f0 == const f1) -// = let x : test (const f0) = itest_inhabited f0 in -// let Mk #_ = x in -// () -// open FStar.Functions -// let itest_injective' : squash (is_inj itest) = -// introduce forall f0 f1. -// itest f0 == itest f1 ==> f0 == f1 -// with introduce _ ==> _ -// with _ . ( -// itest_injective f0 f1; -// const_inversion f0 f1 -// ) -// [@@expect_failure [189]] //itest is not in the right universe to use this lemma -// let fals : squash False = -// CC.no_inj_universes_suc itest - - -// #push-options "--ext 'compat:injectivity'" -// noeq -// type test2 (a:Type u#2) : Type u#1 = -// | Mk2 : test2 a -// #pop-options - -// let test2_inhabited (f:Type u#2) : test2 f = Mk2 -// let test2_injective (f0 f1:Type u#2) -// : Lemma -// (ensures test2 f0 == test2 f1 ==> f0 == f1) -// = let x : test2 f0 = test2_inhabited f0 in -// let Mk2 #_ = x in -// () -// open FStar.Functions -// let itest2_injective' : squash (is_inj test2) = -// introduce forall f0 f1. -// test2 f0 == test2 f1 ==> f0 == f1 -// with introduce _ ==> _ -// with _ . ( -// test2_injective f0 f1 -// ) -// let fals () : squash False = -// CC.no_inj_universes_suc test2 \ No newline at end of file +#push-options "--ext 'compat:injectivity'" +noeq +type test2 (a:Type u#2) : Type u#1 = + | Mk2 : test2 a +#pop-options + +let test2_inhabited (f:Type u#2) : test2 f = Mk2 +let test2_injective (f0 f1:Type u#2) +: Lemma + (ensures test2 f0 == test2 f1 ==> f0 == f1) += let x : test2 f0 = test2_inhabited f0 in + let Mk2 #_ = x in + () +open FStar.Functions +let itest2_injective' : squash (is_inj test2) = + introduce forall f0 f1. + test2 f0 == test2 f1 ==> f0 == f1 + with introduce _ ==> _ + with _ . ( + test2_injective f0 f1 + ) +let fals () : squash False = + CC.no_inj_universes_suc test2 \ No newline at end of file From d1508c85345002daf0d851a2bb260177d8a98a97 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Fri, 19 Apr 2024 19:24:50 -0700 Subject: [PATCH 043/239] try, never injective on params --- ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml | 6 +----- src/smtencoding/FStar.SMTEncoding.Encode.fst | 9 +-------- 2 files changed, 2 insertions(+), 13 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index 8db7327fa61..d881ac473e9 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -7118,11 +7118,7 @@ and (encode_sigelt' : (fun se1 -> FStar_Syntax_Syntax.uu___is_Sig_inductive_typ se1.FStar_Syntax_Syntax.sigel) ses in - let is_injective_on_params = - match tycon with - | FStar_Pervasives_Native.None -> false - | FStar_Pervasives_Native.Some se1 -> - is_sig_inductive_injective_on_params env se1 in + let is_injective_on_params = false in let uu___2 = FStar_Compiler_List.fold_left (fun uu___3 -> diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index 5ce63a6c2f3..4bcf3944deb 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -1777,14 +1777,7 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = | Sig_bundle {ses} -> let tycon = List.tryFind (fun se -> Sig_inductive_typ? se.sigel) ses in - let is_injective_on_params = - match tycon with - | None -> - //Exceptions appear as Sig_bundle without an inductive type - false - | Some se -> - is_sig_inductive_injective_on_params env se - in + let is_injective_on_params = false in let g, env = ses |> List.fold_left From 9615659f92947adc7d3f33dc0565e4d10395a36c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 20 Apr 2024 13:25:57 -0700 Subject: [PATCH 044/239] Tc.Env: populate attrtab for applied arguments too --- src/typechecker/FStar.TypeChecker.Env.fst | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/typechecker/FStar.TypeChecker.Env.fst b/src/typechecker/FStar.TypeChecker.Env.fst index e9997ec08c3..df352f4d2f6 100644 --- a/src/typechecker/FStar.TypeChecker.Env.fst +++ b/src/typechecker/FStar.TypeChecker.Env.fst @@ -494,7 +494,8 @@ let lookup_attr (env:env) (attr:string) : list sigelt = let add_se_to_attrtab env se = let add_one env se attr = BU.smap_add (attrtab env) attr (se :: lookup_attr env attr) in List.iter (fun attr -> - match (Subst.compress attr).n with + let hd, _ = U.head_and_args attr in + match (Subst.compress hd).n with | Tm_fvar fv -> add_one env se (string_of_lid (lid_of_fv fv)) | _ -> ()) se.sigattrs From b2f8f2c075430ae39090dc0f855193438e17532c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 20 Apr 2024 13:32:05 -0700 Subject: [PATCH 045/239] Reflection: add lookup_attr_ses An extension of lookup_attr --- src/reflection/FStar.Reflection.V2.Builtins.fst | 16 +++++++++------- src/reflection/FStar.Reflection.V2.Builtins.fsti | 1 + .../FStar.Reflection.V2.Interpreter.fst | 4 ++++ ulib/FStar.Stubs.Reflection.V2.Builtins.fsti | 14 ++++++++++++-- 4 files changed, 26 insertions(+), 9 deletions(-) diff --git a/src/reflection/FStar.Reflection.V2.Builtins.fst b/src/reflection/FStar.Reflection.V2.Builtins.fst index 13670f59ab0..8cfa8dc0b72 100644 --- a/src/reflection/FStar.Reflection.V2.Builtins.fst +++ b/src/reflection/FStar.Reflection.V2.Builtins.fst @@ -448,14 +448,16 @@ let compare_namedv (x:bv) (y:bv) : order = else if n = 0 then Eq else Gt +let lookup_attr_ses (attr:term) (env:Env.env) : list sigelt = + match (SS.compress_subst attr).n with + | Tm_fvar fv -> Env.lookup_attr env (Ident.string_of_lid (lid_of_fv fv)) + | _ -> [] + let lookup_attr (attr:term) (env:Env.env) : list fv = - match (SS.compress_subst attr).n with - | Tm_fvar fv -> - let ses = Env.lookup_attr env (Ident.string_of_lid (lid_of_fv fv)) in - List.concatMap (fun se -> match U.lid_of_sigelt se with - | None -> [] - | Some l -> [S.lid_as_fv l None]) ses - | _ -> [] + let ses = lookup_attr_ses attr env in + List.concatMap (fun se -> match U.lid_of_sigelt se with + | None -> [] + | Some l -> [S.lid_as_fv l None]) ses let all_defs_in_env (env:Env.env) : list fv = List.map (fun l -> S.lid_as_fv l None) (Env.lidents env) // |> take 10 diff --git a/src/reflection/FStar.Reflection.V2.Builtins.fsti b/src/reflection/FStar.Reflection.V2.Builtins.fsti index 90ddd29d622..4922de6881f 100644 --- a/src/reflection/FStar.Reflection.V2.Builtins.fsti +++ b/src/reflection/FStar.Reflection.V2.Builtins.fsti @@ -35,6 +35,7 @@ module Z = FStar.BigInt val compare_bv : bv -> bv -> order val compare_namedv : namedv -> namedv -> order val lookup_typ : Env.env -> list string -> option sigelt +val lookup_attr_ses : term -> Env.env -> list sigelt val lookup_attr : term -> Env.env -> list fv val all_defs_in_env : Env.env -> list fv val defs_in_module : Env.env -> name -> list fv diff --git a/src/reflection/FStar.Reflection.V2.Interpreter.fst b/src/reflection/FStar.Reflection.V2.Interpreter.fst index 3df1f5a2491..dc66ee81453 100644 --- a/src/reflection/FStar.Reflection.V2.Interpreter.fst +++ b/src/reflection/FStar.Reflection.V2.Interpreter.fst @@ -163,6 +163,10 @@ let reflection_primops : list PO.primitive_step = [ #NRE.e_namedv #NRE.e_namedv #_ RB.compare_namedv; + mk2 "lookup_attr_ses" + #RE.e_term + RB.lookup_attr_ses; + mk2 "lookup_attr" #RE.e_term RB.lookup_attr; diff --git a/ulib/FStar.Stubs.Reflection.V2.Builtins.fsti b/ulib/FStar.Stubs.Reflection.V2.Builtins.fsti index 9ee7cb9bcf0..5cb16c3537c 100644 --- a/ulib/FStar.Stubs.Reflection.V2.Builtins.fsti +++ b/ulib/FStar.Stubs.Reflection.V2.Builtins.fsti @@ -134,8 +134,18 @@ val vars_of_env : env -> list binding (** Returns the current module of an environment. *) val moduleof : env -> name -(** Returns all top-level names marked with a given attribute. -Used e.g. to find all typeclass instances. *) +(** Returns all top-level sigelts marked with a given attribute. The +criterion used is that the [attr] attribute MUST be a top-level name +(Tv_FVar) and any sigelt that has an attribute with [attr] (possibly +applied) is returned. The sigelt can then be inspect to find the +arguments to the attribute, if needed. + +Used e.g. to find all typeclass instances, and read their functional +dependencies. *) +val lookup_attr_ses : attr:term -> env -> list sigelt + +(** As [lookup_attr_ses], but just returns the name associated +to the sigelts. *) val lookup_attr : term -> env -> list fv (** Returns all top-level names in an environment. *) From ffa5a9d10db5c93bdbba83a6ba4db7d0f3a9a24f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 20 Apr 2024 15:28:51 -0700 Subject: [PATCH 046/239] Tactics.Util: string_of_option --- ulib/FStar.Tactics.Util.fst | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/ulib/FStar.Tactics.Util.fst b/ulib/FStar.Tactics.Util.fst index bc53b7a3ac4..197e63fae27 100644 --- a/ulib/FStar.Tactics.Util.fst +++ b/ulib/FStar.Tactics.Util.fst @@ -120,3 +120,8 @@ let rec string_of_list #a (f : a -> Tac string) (l : list a) : Tac string = match l with | [] -> "" | x::xs -> f x ^ ";" ^ string_of_list f xs + +let string_of_option #a (f : a -> Tac string) (o : option a) : Tac string = + match o with + | Some x -> "Some " ^ f x + | None -> "None" From e46a679f0300cd0014acff6179c88a5b41017787 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 20 Apr 2024 16:25:22 -0700 Subject: [PATCH 047/239] Typeclasses: some refactoring --- ulib/FStar.Tactics.Typeclasses.fst | 123 ++++++++++++++++++----------- 1 file changed, 78 insertions(+), 45 deletions(-) diff --git a/ulib/FStar.Tactics.Typeclasses.fst b/ulib/FStar.Tactics.Typeclasses.fst index c417f2462a2..1352c119b6c 100644 --- a/ulib/FStar.Tactics.Typeclasses.fst +++ b/ulib/FStar.Tactics.Typeclasses.fst @@ -16,6 +16,7 @@ module FStar.Tactics.Typeclasses open FStar.Reflection.V2 +module R = FStar.Reflection.V2 open FStar.Stubs.Tactics.Common open FStar.Tactics.Effect open FStar.Stubs.Tactics.V2.Builtins @@ -45,6 +46,19 @@ let tcinstance : unit = () irreducible let no_method : unit = () +noeq +type st_t = { + seen : list term; + glb : list (sigelt & fv); + fuel : int; +} + +noeq +type tc_goal = { + g : term; + head_fv : fv; +} + val fv_eq : fv -> fv -> Tot bool let fv_eq fv1 fv2 = let n1 = inspect_fv fv1 in @@ -89,6 +103,46 @@ let rec maybe_intros () : Tac unit = maybe_intros () | _ -> () +let sigelt_name (se:sigelt) : list fv = + match FStar.Stubs.Reflection.V2.Builtins.inspect_sigelt se with + | Stubs.Reflection.V2.Data.Sg_Let _ lbs -> ( + match lbs with + | [lb] -> [(FStar.Stubs.Reflection.V2.Builtins.inspect_lb lb).lb_fv] + | _ -> [] + ) + | Stubs.Reflection.V2.Data.Sg_Val nm _ _ -> [pack_fv nm] + | _ -> [] + +let trywith (st:st_t) (g:tc_goal) (_:option sigelt) (t typ : term) (k : st_t -> Tac unit) : Tac unit = + match head_of (res_typ typ) with + | None -> + debug (fun () -> "no head for typ of this? " ^ term_to_string t ^ " typ=" ^ term_to_string typ); + raise NoInst + | Some fv' -> + if not (fv_eq fv' g.head_fv) then + raise NoInst; // class mismatch, would be better to not even get here + debug (fun () -> "Trying to apply hypothesis/instance: " ^ term_to_string t); + (fun () -> + apply_noinst t + ) `seq` (fun () -> + debug (fun () -> dump "next"; "apply seems to have worked"); + let st = { st with fuel = st.fuel - 1 } in + k st) + +let local (st:st_t) (g:tc_goal) (k : st_t -> Tac unit) () : Tac unit = + debug (fun () -> "local, goal = " ^ term_to_string g.g); + let bs = vars_of_env (cur_env ()) in + first (fun (b:binding) -> + trywith st g None (pack (Tv_Var b)) b.sort k) + bs + +let global (st:st_t) (g:tc_goal) (k : st_t -> Tac unit) () : Tac unit = + debug (fun () -> "global, goal = " ^ term_to_string g.g); + first (fun (se, fv) -> + let typ = tc (cur_env()) (pack (Tv_FVar fv)) in // FIXME: a bit slow.. but at least it's a simple fvar + trywith st g (Some se) (pack (Tv_FVar fv)) typ k) + st.glb + (* tcresolve': the main typeclass instantiation function. @@ -100,79 +154,58 @@ let rec maybe_intros () : Tac unit = TODO: some form of memoization *) -private -let rec tcresolve' (seen : list term) (glb : list fv) (fuel : int) : Tac unit = - if fuel <= 0 then +let rec tcresolve' (st:st_t) : Tac unit = + if st.fuel <= 0 then raise NoInst; - debug (fun () -> "fuel = " ^ string_of_int fuel); + debug (fun () -> "fuel = " ^ string_of_int st.fuel); maybe_intros(); let g = cur_goal () in (* Try to detect loops *) - if L.existsb (Reflection.V2.TermEq.term_eq g) seen then ( + if L.existsb (Reflection.V2.TermEq.term_eq g) st.seen then ( debug (fun () -> "loop"); raise NoInst ); match head_of g with | None -> - debug (fun () -> "goal does not look like a typeclass"); + debug (fun () -> "Goal does not look like a typeclass"); raise NoInst | Some head_fv -> (* ^ Maybe should check is this really is a class too? *) - let seen = g :: seen in - local head_fv seen glb fuel - `or_else` - global head_fv seen glb fuel - -and local (head_fv : fv) (seen : list term) (glb : list fv) (fuel : int) () : Tac unit = - let bs = vars_of_env (cur_env ()) in - first (fun (b:binding) -> - trywith head_fv seen glb fuel (pack (Tv_Var b)) b.sort) - bs - -and global (head_fv : fv) (seen : list term) (glb : list fv) (fuel : int) () : Tac unit = - first (fun fv -> - let typ = tc (cur_env()) (pack (Tv_FVar fv)) in // FIXME: a bit slow.. but at least it's a simple fvar - trywith head_fv seen glb fuel (pack (Tv_FVar fv)) typ) - glb + let st = { st with seen = g :: st.seen } in + let g = { g = g; head_fv = head_fv; } in + local st g tcresolve' `or_else` global st g tcresolve' -and trywith (head_fv : fv) (seen:list term) (glb : list fv) (fuel:int) (t typ : term) : Tac unit = - //debug (fun () -> "trywith " ^ term_to_string t); - match head_of (res_typ typ) with - | None -> - debug (fun () -> "no head for typ of this? " ^ term_to_string t ^ " typ=" ^ term_to_string typ); - raise NoInst - | Some fv' -> - if fv_eq fv' head_fv - then ( - debug (fun () -> "Trying to apply hypothesis/instance: " ^ term_to_string t); - (fun () -> apply_noinst t) `seq` (fun () -> - debug (fun () -> dump "next"; "apply seems to have worked"); - tcresolve' seen glb (fuel-1)) - ) else ( - //debug (fun () -> "different class: " ^ fv_to_string fv' ^ " <> " ^ fv_to_string head_fv); - raise NoInst - ) +let rec concatMap (f : 'a -> Tac (list 'b)) (l : list 'a) : Tac (list 'b) = + match l with + | [] -> [] + | x::xs -> f x @ concatMap f xs [@@plugin] let tcresolve () : Tac unit = debug (fun () -> dump ""; "tcresolve entry point"); - // We sometimes get goal type as _ -> t - // So intro if that's the case - // Not using intros () directly, since that unfolds aggressively if the term is not an arrow - // TODO: Should we..? Why wouldn't the head always be an FV? let w = cur_witness () in + + // Not using intros () directly, since that unfolds aggressively if the term is not a literal arrow maybe_intros (); // Fetch a list of all instances in scope right now. // TODO: turn this into a hash map per class, ideally one that can be // stored. - let glb = lookup_attr (`tcinstance) (cur_env ()) in + let glb = lookup_attr_ses (`tcinstance) (cur_env ()) in + let glb = glb |> concatMap (fun se -> + sigelt_name se |> concatMap (fun fv -> [(se, fv)])) + in + let st0 = { + seen = []; + glb = glb; + fuel = 16; + } in try - tcresolve' [] glb 16; + tcresolve' st0; debug (fun () -> "Solved to:\n\t" ^ term_to_string w) with | NoInst -> From ff5c3948147548dbdbad0edf4b7874b495b4a66a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 20 Apr 2024 16:26:45 -0700 Subject: [PATCH 048/239] snap --- .../generated/FStar_Reflection_V2_Builtins.ml | 39 +- .../FStar_Reflection_V2_Interpreter.ml | 95 +- .../generated/FStar_Tactics_Typeclasses.ml | 2230 ++++++++++------- .../fstar-lib/generated/FStar_Tactics_Util.ml | 34 + .../generated/FStar_TypeChecker_Env.ml | 21 +- 5 files changed, 1400 insertions(+), 1019 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Reflection_V2_Builtins.ml b/ocaml/fstar-lib/generated/FStar_Reflection_V2_Builtins.ml index f9d5a21a5de..3c6ea77ae05 100644 --- a/ocaml/fstar-lib/generated/FStar_Reflection_V2_Builtins.ml +++ b/ocaml/fstar-lib/generated/FStar_Reflection_V2_Builtins.ml @@ -604,9 +604,9 @@ let (compare_namedv : if n < Prims.int_zero then FStar_Order.Lt else if n = Prims.int_zero then FStar_Order.Eq else FStar_Order.Gt -let (lookup_attr : +let (lookup_attr_ses : FStar_Syntax_Syntax.term -> - FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.fv Prims.list) + FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.sigelt Prims.list) = fun attr -> fun env -> @@ -615,22 +615,27 @@ let (lookup_attr : uu___1.FStar_Syntax_Syntax.n in match uu___ with | FStar_Syntax_Syntax.Tm_fvar fv -> - let ses = - let uu___1 = - let uu___2 = FStar_Syntax_Syntax.lid_of_fv fv in - FStar_Ident.string_of_lid uu___2 in - FStar_TypeChecker_Env.lookup_attr env uu___1 in - FStar_Compiler_List.concatMap - (fun se -> - let uu___1 = FStar_Syntax_Util.lid_of_sigelt se in - match uu___1 with - | FStar_Pervasives_Native.None -> [] - | FStar_Pervasives_Native.Some l -> - let uu___2 = - FStar_Syntax_Syntax.lid_as_fv l - FStar_Pervasives_Native.None in - [uu___2]) ses + let uu___1 = + let uu___2 = FStar_Syntax_Syntax.lid_of_fv fv in + FStar_Ident.string_of_lid uu___2 in + FStar_TypeChecker_Env.lookup_attr env uu___1 | uu___1 -> [] +let (lookup_attr : + FStar_Syntax_Syntax.term -> + FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.fv Prims.list) + = + fun attr -> + fun env -> + let ses = lookup_attr_ses attr env in + FStar_Compiler_List.concatMap + (fun se -> + let uu___ = FStar_Syntax_Util.lid_of_sigelt se in + match uu___ with + | FStar_Pervasives_Native.None -> [] + | FStar_Pervasives_Native.Some l -> + let uu___1 = + FStar_Syntax_Syntax.lid_as_fv l FStar_Pervasives_Native.None in + [uu___1]) ses let (all_defs_in_env : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.fv Prims.list) = fun env -> diff --git a/ocaml/fstar-lib/generated/FStar_Reflection_V2_Interpreter.ml b/ocaml/fstar-lib/generated/FStar_Reflection_V2_Interpreter.ml index 01e6f8d4a05..dd0fc671008 100644 --- a/ocaml/fstar-lib/generated/FStar_Reflection_V2_Interpreter.ml +++ b/ocaml/fstar-lib/generated/FStar_Reflection_V2_Interpreter.ml @@ -337,43 +337,60 @@ let (reflection_primops : FStar_Reflection_V2_Builtins.compare_namedv in let uu___55 = let uu___56 = - mk2 "lookup_attr" + mk2 + "lookup_attr_ses" FStar_Reflection_V2_Embeddings.e_term FStar_Reflection_V2_Embeddings.e_env (FStar_Syntax_Embeddings.e_list - FStar_Reflection_V2_Embeddings.e_fv) + FStar_Reflection_V2_Embeddings.e_sigelt) FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Reflection_V2_NBEEmbeddings.e_env (FStar_TypeChecker_NBETerm.e_list - FStar_Reflection_V2_NBEEmbeddings.e_fv) - FStar_Reflection_V2_Builtins.lookup_attr in + FStar_Reflection_V2_NBEEmbeddings.e_sigelt) + FStar_Reflection_V2_Builtins.lookup_attr_ses in let uu___57 = let uu___58 = - mk1 - "all_defs_in_env" + mk2 + "lookup_attr" + FStar_Reflection_V2_Embeddings.e_term FStar_Reflection_V2_Embeddings.e_env (FStar_Syntax_Embeddings.e_list FStar_Reflection_V2_Embeddings.e_fv) + FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Reflection_V2_NBEEmbeddings.e_env (FStar_TypeChecker_NBETerm.e_list FStar_Reflection_V2_NBEEmbeddings.e_fv) - FStar_Reflection_V2_Builtins.all_defs_in_env in + FStar_Reflection_V2_Builtins.lookup_attr in let uu___59 = let uu___60 = - mk2 - "defs_in_module" + mk1 + "all_defs_in_env" FStar_Reflection_V2_Embeddings.e_env - FStar_Syntax_Embeddings.e_string_list (FStar_Syntax_Embeddings.e_list FStar_Reflection_V2_Embeddings.e_fv) FStar_Reflection_V2_NBEEmbeddings.e_env - FStar_TypeChecker_NBETerm.e_string_list (FStar_TypeChecker_NBETerm.e_list FStar_Reflection_V2_NBEEmbeddings.e_fv) - FStar_Reflection_V2_Builtins.defs_in_module in + FStar_Reflection_V2_Builtins.all_defs_in_env in let uu___61 = let uu___62 = mk2 + "defs_in_module" + FStar_Reflection_V2_Embeddings.e_env + FStar_Syntax_Embeddings.e_string_list + ( + FStar_Syntax_Embeddings.e_list + FStar_Reflection_V2_Embeddings.e_fv) + FStar_Reflection_V2_NBEEmbeddings.e_env + FStar_TypeChecker_NBETerm.e_string_list + ( + FStar_TypeChecker_NBETerm.e_list + FStar_Reflection_V2_NBEEmbeddings.e_fv) + FStar_Reflection_V2_Builtins.defs_in_module in + let uu___63 = + let uu___64 + = + mk2 "term_eq" FStar_Reflection_V2_Embeddings.e_term FStar_Reflection_V2_Embeddings.e_term @@ -382,8 +399,9 @@ let (reflection_primops : FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_TypeChecker_NBETerm.e_bool FStar_Reflection_V2_Builtins.term_eq in - let uu___63 = - let uu___64 + let uu___65 + = + let uu___66 = mk1 "moduleof" @@ -392,9 +410,9 @@ let (reflection_primops : FStar_Reflection_V2_NBEEmbeddings.e_env FStar_TypeChecker_NBETerm.e_string_list FStar_Reflection_V2_Builtins.moduleof in - let uu___65 + let uu___67 = - let uu___66 + let uu___68 = mk1 "vars_of_env" @@ -405,9 +423,9 @@ let (reflection_primops : (FStar_TypeChecker_NBETerm.e_list FStar_Reflection_V2_NBEEmbeddings.e_binding) FStar_Reflection_V2_Builtins.vars_of_env in - let uu___67 + let uu___69 = - let uu___68 + let uu___70 = mk2 "lookup_typ" @@ -420,9 +438,9 @@ let (reflection_primops : (FStar_TypeChecker_NBETerm.e_option FStar_Reflection_V2_NBEEmbeddings.e_sigelt) FStar_Reflection_V2_Builtins.lookup_typ in - let uu___69 + let uu___71 = - let uu___70 + let uu___72 = mk1 "env_open_modules" @@ -433,9 +451,9 @@ let (reflection_primops : (FStar_TypeChecker_NBETerm.e_list FStar_TypeChecker_NBETerm.e_string_list) FStar_Reflection_V2_Builtins.env_open_modules in - let uu___71 + let uu___73 = - let uu___72 + let uu___74 = mk1 "implode_qn" @@ -444,9 +462,9 @@ let (reflection_primops : FStar_TypeChecker_NBETerm.e_string_list FStar_TypeChecker_NBETerm.e_string FStar_Reflection_V2_Builtins.implode_qn in - let uu___73 + let uu___75 = - let uu___74 + let uu___76 = mk1 "explode_qn" @@ -455,9 +473,9 @@ let (reflection_primops : FStar_TypeChecker_NBETerm.e_string FStar_TypeChecker_NBETerm.e_string_list FStar_Reflection_V2_Builtins.explode_qn in - let uu___75 + let uu___77 = - let uu___76 + let uu___78 = mk2 "compare_string" @@ -468,9 +486,9 @@ let (reflection_primops : FStar_TypeChecker_NBETerm.e_string FStar_TypeChecker_NBETerm.e_int FStar_Reflection_V2_Builtins.compare_string in - let uu___77 + let uu___79 = - let uu___78 + let uu___80 = mk2 "push_namedv" @@ -481,9 +499,9 @@ let (reflection_primops : FStar_Reflection_V2_NBEEmbeddings.e_namedv FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_Builtins.push_namedv in - let uu___79 + let uu___81 = - let uu___80 + let uu___82 = mk1 "range_of_term" @@ -492,9 +510,9 @@ let (reflection_primops : FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_TypeChecker_NBETerm.e_range FStar_Reflection_V2_Builtins.range_of_term in - let uu___81 + let uu___83 = - let uu___82 + let uu___84 = mk1 "range_of_sigelt" @@ -503,9 +521,9 @@ let (reflection_primops : FStar_Reflection_V2_NBEEmbeddings.e_sigelt FStar_TypeChecker_NBETerm.e_range FStar_Reflection_V2_Builtins.range_of_sigelt in - let uu___83 + let uu___85 = - let uu___84 + let uu___86 = mk1 "inspect_ident" @@ -518,9 +536,9 @@ let (reflection_primops : FStar_TypeChecker_NBETerm.e_string FStar_TypeChecker_NBETerm.e_range) FStar_Reflection_V2_Builtins.inspect_ident in - let uu___85 + let uu___87 = - let uu___86 + let uu___88 = mk1 "pack_ident" @@ -533,7 +551,10 @@ let (reflection_primops : FStar_TypeChecker_NBETerm.e_range) FStar_Reflection_V2_NBEEmbeddings.e_univ_name FStar_Reflection_V2_Builtins.pack_ident in - [uu___86] in + [uu___88] in + uu___86 + :: + uu___87 in uu___84 :: uu___85 in diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml index 25c69d85574..7a450af4589 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml @@ -8,12 +8,12 @@ let (debug : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (29)) (Prims.of_int (5)) (Prims.of_int (29)) + (Prims.of_int (30)) (Prims.of_int (5)) (Prims.of_int (30)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (29)) (Prims.of_int (2)) (Prims.of_int (30)) + (Prims.of_int (30)) (Prims.of_int (2)) (Prims.of_int (31)) (Prims.of_int (16))))) (Obj.magic (FStar_Tactics_V2_Builtins.debugging ())) (fun uu___ -> @@ -27,14 +27,14 @@ let (debug : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (30)) (Prims.of_int (10)) - (Prims.of_int (30)) (Prims.of_int (16))))) + (Prims.of_int (31)) (Prims.of_int (10)) + (Prims.of_int (31)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (30)) (Prims.of_int (4)) - (Prims.of_int (30)) (Prims.of_int (16))))) + (Prims.of_int (31)) (Prims.of_int (4)) + (Prims.of_int (31)) (Prims.of_int (16))))) (Obj.magic (f ())) (fun uu___1 -> (fun uu___1 -> @@ -50,6 +50,28 @@ let op_At : 'uuuuu . unit -> 'uuuuu Prims.list -> 'uuuuu Prims.list -> 'uuuuu Prims.list = fun uu___ -> FStar_List_Tot_Base.op_At +type st_t = + { + seen: FStar_Tactics_NamedView.term Prims.list ; + glb: (FStar_Reflection_Types.sigelt * FStar_Reflection_Types.fv) Prims.list ; + fuel: Prims.int } +let (__proj__Mkst_t__item__seen : + st_t -> FStar_Tactics_NamedView.term Prims.list) = + fun projectee -> match projectee with | { seen; glb; fuel;_} -> seen +let (__proj__Mkst_t__item__glb : + st_t -> + (FStar_Reflection_Types.sigelt * FStar_Reflection_Types.fv) Prims.list) + = fun projectee -> match projectee with | { seen; glb; fuel;_} -> glb +let (__proj__Mkst_t__item__fuel : st_t -> Prims.int) = + fun projectee -> match projectee with | { seen; glb; fuel;_} -> fuel +type tc_goal = + { + g: FStar_Tactics_NamedView.term ; + head_fv: FStar_Reflection_Types.fv } +let (__proj__Mktc_goal__item__g : tc_goal -> FStar_Tactics_NamedView.term) = + fun projectee -> match projectee with | { g; head_fv;_} -> g +let (__proj__Mktc_goal__item__head_fv : tc_goal -> FStar_Reflection_Types.fv) + = fun projectee -> match projectee with | { g; head_fv;_} -> head_fv let (fv_eq : FStar_Reflection_Types.fv -> FStar_Reflection_Types.fv -> Prims.bool) = fun fv1 -> @@ -66,12 +88,12 @@ let rec (head_of : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (57)) (Prims.of_int (8)) (Prims.of_int (57)) + (Prims.of_int (71)) (Prims.of_int (8)) (Prims.of_int (71)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (57)) (Prims.of_int (2)) (Prims.of_int (61)) + (Prims.of_int (71)) (Prims.of_int (2)) (Prims.of_int (75)) (Prims.of_int (13))))) (Obj.magic (FStar_Tactics_NamedView.inspect t)) (fun uu___ -> @@ -103,12 +125,12 @@ let rec (res_typ : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (64)) (Prims.of_int (8)) (Prims.of_int (64)) + (Prims.of_int (78)) (Prims.of_int (8)) (Prims.of_int (78)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (64)) (Prims.of_int (2)) (Prims.of_int (70)) + (Prims.of_int (78)) (Prims.of_int (2)) (Prims.of_int (84)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_NamedView.inspect t)) (fun uu___ -> @@ -154,12 +176,12 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (85)) (Prims.of_int (10)) (Prims.of_int (85)) + (Prims.of_int (99)) (Prims.of_int (10)) (Prims.of_int (99)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (86)) (Prims.of_int (2)) (Prims.of_int (90)) + (Prims.of_int (100)) (Prims.of_int (2)) (Prims.of_int (104)) (Prims.of_int (11))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_goal ())) (fun uu___1 -> @@ -169,13 +191,13 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (86)) (Prims.of_int (8)) - (Prims.of_int (86)) (Prims.of_int (17))))) + (Prims.of_int (100)) (Prims.of_int (8)) + (Prims.of_int (100)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (86)) (Prims.of_int (2)) - (Prims.of_int (90)) (Prims.of_int (11))))) + (Prims.of_int (100)) (Prims.of_int (2)) + (Prims.of_int (104)) (Prims.of_int (11))))) (Obj.magic (FStar_Tactics_NamedView.inspect g)) (fun uu___1 -> (fun uu___1 -> @@ -188,17 +210,17 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (88)) + (Prims.of_int (102)) (Prims.of_int (4)) - (Prims.of_int (88)) + (Prims.of_int (102)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (89)) + (Prims.of_int (103)) (Prims.of_int (4)) - (Prims.of_int (89)) + (Prims.of_int (103)) (Prims.of_int (19))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -206,17 +228,17 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (88)) + (Prims.of_int (102)) (Prims.of_int (11)) - (Prims.of_int (88)) + (Prims.of_int (102)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (88)) + (Prims.of_int (102)) (Prims.of_int (4)) - (Prims.of_int (88)) + (Prims.of_int (102)) (Prims.of_int (21))))) (Obj.magic (FStar_Tactics_V2_Builtins.intro @@ -232,148 +254,687 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.repr (FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> ())))) uu___1))) uu___1) -let rec (tcresolve' : - FStar_Tactics_NamedView.term Prims.list -> - FStar_Reflection_Types.fv Prims.list -> - Prims.int -> (unit, unit) FStar_Tactics_Effect.tac_repr) +let (sigelt_name : + FStar_Reflection_Types.sigelt -> FStar_Reflection_Types.fv Prims.list) = + fun se -> + match FStar_Reflection_V2_Builtins.inspect_sigelt se with + | FStar_Reflection_V2_Data.Sg_Let (uu___, lbs) -> + (match lbs with + | lb::[] -> + [(FStar_Reflection_V2_Builtins.inspect_lb lb).FStar_Reflection_V2_Data.lb_fv] + | uu___1 -> []) + | FStar_Reflection_V2_Data.Sg_Val (nm, uu___, uu___1) -> + [FStar_Reflection_V2_Builtins.pack_fv nm] + | uu___ -> [] +let (trywith : + st_t -> + tc_goal -> + FStar_Reflection_Types.sigelt FStar_Pervasives_Native.option -> + FStar_Tactics_NamedView.term -> + FStar_Tactics_NamedView.term -> + (st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) -> + (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun seen -> - fun glb -> - fun fuel -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (105)) (Prims.of_int (4)) - (Prims.of_int (106)) (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (107)) (Prims.of_int (4)) - (Prims.of_int (128)) (Prims.of_int (34))))) - (if fuel <= Prims.int_zero - then FStar_Tactics_Effect.raise NoInst - else FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())) - (fun uu___ -> - (fun uu___ -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (107)) (Prims.of_int (4)) - (Prims.of_int (107)) (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (109)) (Prims.of_int (4)) - (Prims.of_int (128)) (Prims.of_int (34))))) - (Obj.magic - (debug - (fun uu___1 -> - (fun uu___1 -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - Prims.strcat "fuel = " - (Prims.string_of_int fuel)))) - uu___1))) - (fun uu___1 -> - (fun uu___1 -> - Obj.magic - (FStar_Tactics_Effect.tac_bind + fun st -> + fun g -> + fun uu___ -> + fun t -> + fun typ -> + fun k -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (117)) (Prims.of_int (10)) + (Prims.of_int (117)) (Prims.of_int (31))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (117)) (Prims.of_int (4)) + (Prims.of_int (130)) (Prims.of_int (13))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (117)) (Prims.of_int (18)) + (Prims.of_int (117)) (Prims.of_int (31))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (117)) (Prims.of_int (10)) + (Prims.of_int (117)) (Prims.of_int (31))))) + (Obj.magic (res_typ typ)) + (fun uu___1 -> + (fun uu___1 -> Obj.magic (head_of uu___1)) uu___1))) + (fun uu___1 -> + (fun uu___1 -> + match uu___1 with + | FStar_Pervasives_Native.None -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (119)) + (Prims.of_int (6)) + (Prims.of_int (119)) + (Prims.of_int (104))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (120)) + (Prims.of_int (6)) + (Prims.of_int (120)) + (Prims.of_int (18))))) + (Obj.magic + (debug + (fun uu___2 -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (119)) + (Prims.of_int (53)) + (Prims.of_int (119)) + (Prims.of_int (103))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "prims.fst" + (Prims.of_int (590)) + (Prims.of_int (19)) + (Prims.of_int (590)) + (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (119)) + (Prims.of_int (53)) + (Prims.of_int (119)) + (Prims.of_int (69))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (119)) + (Prims.of_int (53)) + (Prims.of_int (119)) + (Prims.of_int (103))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string + t)) + (fun uu___3 -> + (fun uu___3 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (119)) + (Prims.of_int (72)) + (Prims.of_int (119)) + (Prims.of_int (103))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "prims.fst" + (Prims.of_int (590)) + (Prims.of_int (19)) + (Prims.of_int (590)) + (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + ( + Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (119)) + (Prims.of_int (85)) + (Prims.of_int (119)) + (Prims.of_int (103))))) + (FStar_Sealed.seal + ( + Obj.magic + (FStar_Range.mk_range + "prims.fst" + (Prims.of_int (590)) + (Prims.of_int (19)) + (Prims.of_int (590)) + (Prims.of_int (31))))) + (Obj.magic + ( + FStar_Tactics_V2_Builtins.term_to_string + typ)) + (fun uu___4 + -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___5 -> + Prims.strcat + " typ=" + uu___4)))) + (fun uu___4 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___5 + -> + Prims.strcat + uu___3 + uu___4)))) + uu___3))) + (fun uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> + Prims.strcat + "no head for typ of this? " + uu___3))))) + (fun uu___2 -> + FStar_Tactics_Effect.raise NoInst)) + | FStar_Pervasives_Native.Some fv' -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (122)) + (Prims.of_int (6)) + (Prims.of_int (123)) + (Prims.of_int (20))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (124)) + (Prims.of_int (6)) + (Prims.of_int (130)) + (Prims.of_int (13))))) + (if Prims.op_Negation (fv_eq fv' g.head_fv) + then FStar_Tactics_Effect.raise NoInst + else + FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> ())) + (fun uu___2 -> + (fun uu___2 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (124)) + (Prims.of_int (6)) + (Prims.of_int (124)) + (Prims.of_int (82))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (125)) + (Prims.of_int (6)) + (Prims.of_int (130)) + (Prims.of_int (13))))) + (Obj.magic + (debug + (fun uu___3 -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (124)) + (Prims.of_int (65)) + (Prims.of_int (124)) + (Prims.of_int (81))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "prims.fst" + (Prims.of_int (590)) + (Prims.of_int (19)) + (Prims.of_int (590)) + (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string + t)) + (fun uu___4 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___5 -> + Prims.strcat + "Trying to apply hypothesis/instance: " + uu___4))))) + (fun uu___3 -> + (fun uu___3 -> + Obj.magic + (FStar_Tactics_V2_Derived.seq + (fun uu___4 -> + FStar_Tactics_V2_Derived.apply_noinst + t) + (fun uu___4 -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (128)) + (Prims.of_int (8)) + (Prims.of_int (128)) + (Prims.of_int (67))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (128)) + (Prims.of_int (68)) + (Prims.of_int (130)) + (Prims.of_int (12))))) + (Obj.magic + (debug + (fun uu___5 + -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (128)) + (Prims.of_int (25)) + (Prims.of_int (128)) + (Prims.of_int (36))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (128)) + (Prims.of_int (38)) + (Prims.of_int (128)) + (Prims.of_int (66))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.dump + "next")) + (fun + uu___6 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___7 -> + "apply seems to have worked"))))) + (fun uu___5 -> + (fun uu___5 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (129)) + (Prims.of_int (19)) + (Prims.of_int (129)) + (Prims.of_int (45))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (130)) + (Prims.of_int (8)) + (Prims.of_int (130)) + (Prims.of_int (12))))) + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___6 -> + { + seen = + (st.seen); + glb = + (st.glb); + fuel = + (st.fuel + - + Prims.int_one) + })) + (fun + uu___6 -> + (fun st1 + -> + Obj.magic + (k st1)) + uu___6))) + uu___5)))) + uu___3))) uu___2))) uu___1) +let (local : + st_t -> + tc_goal -> + (st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) -> + unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) + = + fun st -> + fun g -> + fun k -> + fun uu___ -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (133)) (Prims.of_int (4)) + (Prims.of_int (133)) (Prims.of_int (59))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (133)) (Prims.of_int (60)) + (Prims.of_int (137)) (Prims.of_int (12))))) + (Obj.magic + (debug + (fun uu___1 -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (133)) (Prims.of_int (40)) + (Prims.of_int (133)) (Prims.of_int (58))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "prims.fst" + (Prims.of_int (590)) (Prims.of_int (19)) + (Prims.of_int (590)) (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string g.g)) + (fun uu___2 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> + Prims.strcat "local, goal = " uu___2))))) + (fun uu___1 -> + (fun uu___1 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (134)) (Prims.of_int (13)) + (Prims.of_int (134)) (Prims.of_int (37))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (135)) (Prims.of_int (4)) + (Prims.of_int (137)) (Prims.of_int (12))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (134)) + (Prims.of_int (25)) + (Prims.of_int (134)) + (Prims.of_int (37))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (134)) + (Prims.of_int (13)) + (Prims.of_int (134)) + (Prims.of_int (37))))) + (Obj.magic (FStar_Tactics_V2_Derived.cur_env ())) + (fun uu___2 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> + FStar_Reflection_V2_Builtins.vars_of_env + uu___2)))) + (fun uu___2 -> + (fun bs -> + Obj.magic + (first + (fun b -> + trywith st g + FStar_Pervasives_Native.None + (FStar_Tactics_NamedView.pack + (FStar_Tactics_NamedView.Tv_Var + (FStar_Tactics_V2_SyntaxCoercions.binding_to_namedv + b))) + b.FStar_Reflection_V2_Data.sort3 k) bs)) + uu___2))) uu___1) +let (global : + st_t -> + tc_goal -> + (st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) -> + unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) + = + fun st -> + fun g -> + fun k -> + fun uu___ -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (140)) (Prims.of_int (4)) + (Prims.of_int (140)) (Prims.of_int (60))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (141)) (Prims.of_int (4)) + (Prims.of_int (144)) (Prims.of_int (16))))) + (Obj.magic + (debug + (fun uu___1 -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (140)) (Prims.of_int (41)) + (Prims.of_int (140)) (Prims.of_int (59))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "prims.fst" + (Prims.of_int (590)) (Prims.of_int (19)) + (Prims.of_int (590)) (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string g.g)) + (fun uu___2 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> + Prims.strcat "global, goal = " uu___2))))) + (fun uu___1 -> + (fun uu___1 -> + Obj.magic + (first + (fun uu___2 -> + match uu___2 with + | (se, fv) -> + FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (109)) - (Prims.of_int (4)) - (Prims.of_int (109)) - (Prims.of_int (18))))) + (Prims.of_int (142)) + (Prims.of_int (24)) + (Prims.of_int (142)) + (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (109)) - (Prims.of_int (19)) - (Prims.of_int (128)) - (Prims.of_int (34))))) - (Obj.magic (maybe_intros ())) - (fun uu___2 -> - (fun uu___2 -> + (Prims.of_int (143)) + (Prims.of_int (14)) + (Prims.of_int (143)) + (Prims.of_int (62))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (142)) + (Prims.of_int (27)) + (Prims.of_int (142)) + (Prims.of_int (38))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (142)) + (Prims.of_int (24)) + (Prims.of_int (142)) + (Prims.of_int (58))))) + (Obj.magic + (FStar_Tactics_V2_Derived.cur_env ())) + (fun uu___3 -> + (fun uu___3 -> + Obj.magic + (FStar_Tactics_V2_Builtins.tc + uu___3 + (FStar_Tactics_NamedView.pack + (FStar_Tactics_NamedView.Tv_FVar + fv)))) uu___3))) + (fun uu___3 -> + (fun typ -> Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (110)) - (Prims.of_int (12)) - (Prims.of_int (110)) - (Prims.of_int (23))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (113)) - (Prims.of_int (4)) - (Prims.of_int (128)) - (Prims.of_int (34))))) - (Obj.magic - (FStar_Tactics_V2_Derived.cur_goal - ())) - (fun uu___3 -> - (fun g -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (113)) - (Prims.of_int (4)) - (Prims.of_int (116)) - (Prims.of_int (5))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (118)) - (Prims.of_int (4)) - (Prims.of_int (128)) - (Prims.of_int (34))))) - (if - FStar_List_Tot_Base.existsb - (FStar_Reflection_V2_TermEq.term_eq - g) seen - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (114)) + (trywith st g + (FStar_Pervasives_Native.Some se) + (FStar_Tactics_NamedView.pack + (FStar_Tactics_NamedView.Tv_FVar + fv)) typ k)) uu___3)) + st.glb)) uu___1) +let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = + fun st -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (158)) (Prims.of_int (4)) (Prims.of_int (159)) + (Prims.of_int (18))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (160)) (Prims.of_int (4)) (Prims.of_int (180)) + (Prims.of_int (60))))) + (if st.fuel <= Prims.int_zero + then FStar_Tactics_Effect.raise NoInst + else FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())) + (fun uu___ -> + (fun uu___ -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (160)) (Prims.of_int (4)) + (Prims.of_int (160)) (Prims.of_int (55))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (162)) (Prims.of_int (4)) + (Prims.of_int (180)) (Prims.of_int (60))))) + (Obj.magic + (debug + (fun uu___1 -> + (fun uu___1 -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> + Prims.strcat "fuel = " + (Prims.string_of_int st.fuel)))) + uu___1))) + (fun uu___1 -> + (fun uu___1 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (162)) (Prims.of_int (4)) + (Prims.of_int (162)) (Prims.of_int (18))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (162)) (Prims.of_int (19)) + (Prims.of_int (180)) (Prims.of_int (60))))) + (Obj.magic (maybe_intros ())) + (fun uu___2 -> + (fun uu___2 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (163)) + (Prims.of_int (12)) + (Prims.of_int (163)) + (Prims.of_int (23))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (166)) + (Prims.of_int (4)) + (Prims.of_int (180)) + (Prims.of_int (60))))) + (Obj.magic + (FStar_Tactics_V2_Derived.cur_goal + ())) + (fun uu___3 -> + (fun g -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (166)) + (Prims.of_int (4)) + (Prims.of_int (169)) + (Prims.of_int (5))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (171)) + (Prims.of_int (4)) + (Prims.of_int (180)) + (Prims.of_int (60))))) + (if + FStar_List_Tot_Base.existsb + (FStar_Reflection_V2_TermEq.term_eq + g) st.seen + then + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (167)) (Prims.of_int (6)) - (Prims.of_int (114)) + (Prims.of_int (167)) (Prims.of_int (30))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (115)) + (Prims.of_int (168)) (Prims.of_int (6)) - (Prims.of_int (115)) + (Prims.of_int (168)) (Prims.of_int (18))))) - (Obj.magic - ( - debug - (fun + (Obj.magic + (debug + (fun uu___3 -> (fun uu___3 -> @@ -383,49 +944,44 @@ let rec (tcresolve' : uu___4 -> "loop"))) uu___3))) - (fun uu___3 - -> - FStar_Tactics_Effect.raise - NoInst))) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 - -> ())))) - (fun uu___3 -> - (fun uu___3 -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range + (fun uu___3 -> + FStar_Tactics_Effect.raise + NoInst))) + else + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> + ())))) + (fun uu___3 -> + (fun uu___3 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (118)) + (Prims.of_int (171)) (Prims.of_int (10)) - (Prims.of_int (118)) + (Prims.of_int (171)) (Prims.of_int (19))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (118)) + (Prims.of_int (171)) (Prims.of_int (4)) - (Prims.of_int (128)) - (Prims.of_int (34))))) - (Obj.magic - ( - head_of g)) - (fun uu___4 - -> - (fun - uu___4 -> - match uu___4 - with - | - FStar_Pervasives_Native.None + (Prims.of_int (180)) + (Prims.of_int (60))))) + (Obj.magic + (head_of g)) + (fun uu___4 -> + (fun uu___4 + -> + match uu___4 + with + | + FStar_Pervasives_Native.None -> Obj.magic (FStar_Tactics_Effect.tac_bind @@ -433,17 +989,17 @@ let rec (tcresolve' : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (120)) + (Prims.of_int (173)) (Prims.of_int (6)) - (Prims.of_int (120)) + (Prims.of_int (173)) (Prims.of_int (61))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (121)) + (Prims.of_int (174)) (Prims.of_int (6)) - (Prims.of_int (121)) + (Prims.of_int (174)) (Prims.of_int (18))))) (Obj.magic (debug @@ -455,14 +1011,14 @@ let rec (tcresolve' : (FStar_Tactics_Effect.lift_div_tac (fun uu___6 -> - "goal does not look like a typeclass"))) + "Goal does not look like a typeclass"))) uu___5))) (fun uu___5 -> FStar_Tactics_Effect.raise NoInst)) - | - FStar_Pervasives_Native.Some + | + FStar_Pervasives_Native.Some head_fv -> Obj.magic @@ -471,455 +1027,144 @@ let rec (tcresolve' : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (125)) + (Prims.of_int (178)) (Prims.of_int (17)) - (Prims.of_int (125)) - (Prims.of_int (26))))) + (Prims.of_int (178)) + (Prims.of_int (44))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (126)) - (Prims.of_int (6)) - (Prims.of_int (128)) - (Prims.of_int (34))))) + (Prims.of_int (178)) + (Prims.of_int (49)) + (Prims.of_int (180)) + (Prims.of_int (60))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___5 -> - g :: seen)) + { + seen = (g + :: + (st.seen)); + glb = + (st.glb); + fuel = + (st.fuel) + })) (fun uu___5 -> - (fun - seen1 -> - Obj.magic - (FStar_Tactics_V2_Derived.or_else - (local - head_fv - seen1 glb - fuel) - (global - head_fv - seen1 glb - fuel))) - uu___5))) - uu___4))) - uu___3))) uu___3))) - uu___2))) uu___1))) uu___) -and (local : - FStar_Reflection_Types.fv -> - FStar_Tactics_NamedView.term Prims.list -> - FStar_Reflection_Types.fv Prims.list -> - Prims.int -> unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun head_fv -> - fun seen -> - fun glb -> - fun fuel -> - fun uu___ -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (131)) (Prims.of_int (13)) - (Prims.of_int (131)) (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (132)) (Prims.of_int (4)) - (Prims.of_int (134)) (Prims.of_int (12))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (131)) (Prims.of_int (25)) - (Prims.of_int (131)) (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (131)) (Prims.of_int (13)) - (Prims.of_int (131)) (Prims.of_int (37))))) - (Obj.magic (FStar_Tactics_V2_Derived.cur_env ())) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_Reflection_V2_Builtins.vars_of_env uu___1)))) - (fun uu___1 -> - (fun bs -> - Obj.magic - (first - (fun b -> - trywith head_fv seen glb fuel - (FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_Var - (FStar_Tactics_V2_SyntaxCoercions.binding_to_namedv - b))) b.FStar_Reflection_V2_Data.sort3) - bs)) uu___1) -and (global : - FStar_Reflection_Types.fv -> - FStar_Tactics_NamedView.term Prims.list -> - FStar_Reflection_Types.fv Prims.list -> - Prims.int -> unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun head_fv -> - fun seen -> - fun glb -> - fun fuel -> - fun uu___ -> - first - (fun fv -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (138)) (Prims.of_int (24)) - (Prims.of_int (138)) (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (139)) (Prims.of_int (14)) - (Prims.of_int (139)) (Prims.of_int (67))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (138)) (Prims.of_int (27)) - (Prims.of_int (138)) (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (138)) (Prims.of_int (24)) - (Prims.of_int (138)) (Prims.of_int (58))))) - (Obj.magic (FStar_Tactics_V2_Derived.cur_env ())) - (fun uu___1 -> - (fun uu___1 -> - Obj.magic - (FStar_Tactics_V2_Builtins.tc uu___1 - (FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_FVar fv)))) - uu___1))) - (fun uu___1 -> - (fun typ -> - Obj.magic - (trywith head_fv seen glb fuel - (FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_FVar fv)) typ)) - uu___1)) glb -and (trywith : - FStar_Reflection_Types.fv -> - FStar_Tactics_NamedView.term Prims.list -> - FStar_Reflection_Types.fv Prims.list -> - Prims.int -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun head_fv -> - fun seen -> - fun glb -> - fun fuel -> - fun t -> - fun typ -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (144)) (Prims.of_int (10)) - (Prims.of_int (144)) (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (144)) (Prims.of_int (4)) - (Prims.of_int (158)) (Prims.of_int (7))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (144)) (Prims.of_int (18)) - (Prims.of_int (144)) (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (144)) (Prims.of_int (10)) - (Prims.of_int (144)) (Prims.of_int (31))))) - (Obj.magic (res_typ typ)) - (fun uu___ -> - (fun uu___ -> Obj.magic (head_of uu___)) uu___))) - (fun uu___ -> - (fun uu___ -> - match uu___ with - | FStar_Pervasives_Native.None -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (146)) - (Prims.of_int (6)) - (Prims.of_int (146)) - (Prims.of_int (104))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (147)) - (Prims.of_int (6)) - (Prims.of_int (147)) - (Prims.of_int (18))))) - (Obj.magic - (debug - (fun uu___1 -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (146)) - (Prims.of_int (53)) - (Prims.of_int (146)) - (Prims.of_int (103))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "prims.fst" - (Prims.of_int (590)) - (Prims.of_int (19)) - (Prims.of_int (590)) - (Prims.of_int (31))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (146)) - (Prims.of_int (53)) - (Prims.of_int (146)) - (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (146)) - (Prims.of_int (53)) - (Prims.of_int (146)) - (Prims.of_int (103))))) - (Obj.magic - (FStar_Tactics_V2_Builtins.term_to_string - t)) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - ( - FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (146)) - (Prims.of_int (72)) - (Prims.of_int (146)) - (Prims.of_int (103))))) - (FStar_Sealed.seal - (Obj.magic - ( - FStar_Range.mk_range - "prims.fst" - (Prims.of_int (590)) - (Prims.of_int (19)) - (Prims.of_int (590)) - (Prims.of_int (31))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - ( - FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (146)) - (Prims.of_int (85)) - (Prims.of_int (146)) - (Prims.of_int (103))))) - ( - FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "prims.fst" - (Prims.of_int (590)) - (Prims.of_int (19)) - (Prims.of_int (590)) - (Prims.of_int (31))))) - ( + (fun st1 + -> Obj.magic - (FStar_Tactics_V2_Builtins.term_to_string - typ)) - ( - fun - uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___4 -> - Prims.strcat - " typ=" - uu___3)))) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___4 -> - Prims.strcat - uu___2 - uu___3)))) - uu___2))) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - Prims.strcat - "no head for typ of this? " - uu___2))))) - (fun uu___1 -> - FStar_Tactics_Effect.raise NoInst))) - | FStar_Pervasives_Native.Some fv' -> - Obj.magic - (Obj.repr - (if fv_eq fv' head_fv - then - Obj.repr - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (151)) - (Prims.of_int (8)) - (Prims.of_int (151)) - (Prims.of_int (84))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (152)) - (Prims.of_int (8)) - (Prims.of_int (154)) - (Prims.of_int (39))))) - (Obj.magic - (debug - (fun uu___1 -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (151)) - (Prims.of_int (67)) - (Prims.of_int (151)) - (Prims.of_int (83))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "prims.fst" - (Prims.of_int (590)) - (Prims.of_int (19)) - (Prims.of_int (590)) - (Prims.of_int (31))))) - (Obj.magic - (FStar_Tactics_V2_Builtins.term_to_string - t)) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - Prims.strcat - "Trying to apply hypothesis/instance: " - uu___2))))) - (fun uu___1 -> - (fun uu___1 -> - Obj.magic - (FStar_Tactics_V2_Derived.seq - (fun uu___2 -> - FStar_Tactics_V2_Derived.apply_noinst - t) - (fun uu___2 -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (153)) - (Prims.of_int (10)) - (Prims.of_int (153)) - (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (154)) - (Prims.of_int (10)) - (Prims.of_int (154)) - (Prims.of_int (38))))) - (Obj.magic - (debug - (fun uu___3 -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (153)) - (Prims.of_int (27)) - (Prims.of_int (153)) - (Prims.of_int (38))))) - (FStar_Sealed.seal + (Prims.of_int (179)) + (Prims.of_int (16)) + (Prims.of_int (179)) + (Prims.of_int (41))))) + (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (153)) - (Prims.of_int (40)) - (Prims.of_int (153)) - (Prims.of_int (68))))) - (Obj.magic - (FStar_Tactics_V2_Builtins.dump - "next")) - (fun uu___4 - -> - FStar_Tactics_Effect.lift_div_tac + (Prims.of_int (180)) + (Prims.of_int (6)) + (Prims.of_int (180)) + (Prims.of_int (60))))) + (FStar_Tactics_Effect.lift_div_tac (fun uu___5 -> - "apply seems to have worked"))))) - (fun uu___3 -> - (fun uu___3 -> - Obj.magic - (tcresolve' - seen glb - (fuel - - Prims.int_one))) - uu___3)))) uu___1)) - else - Obj.repr - (FStar_Tactics_Effect.raise NoInst)))) - uu___) + { + g; + head_fv + })) + (fun + uu___5 -> + (fun g1 + -> + Obj.magic + (FStar_Tactics_V2_Derived.or_else + (local + st1 g1 + tcresolve') + (global + st1 g1 + tcresolve'))) + uu___5))) + uu___5))) + uu___4))) + uu___3))) uu___3))) + uu___2))) uu___1))) uu___) +let rec concatMap : + 'a 'b . + ('a -> ('b Prims.list, unit) FStar_Tactics_Effect.tac_repr) -> + 'a Prims.list -> ('b Prims.list, unit) FStar_Tactics_Effect.tac_repr + = + fun uu___1 -> + fun uu___ -> + (fun f -> + fun l -> + match l with + | [] -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> []))) + | x::xs -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (185)) (Prims.of_int (13)) + (Prims.of_int (185)) (Prims.of_int (16))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (185)) (Prims.of_int (13)) + (Prims.of_int (185)) (Prims.of_int (33))))) + (Obj.magic (f x)) + (fun uu___ -> + (fun uu___ -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (185)) + (Prims.of_int (19)) + (Prims.of_int (185)) + (Prims.of_int (33))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (185)) + (Prims.of_int (13)) + (Prims.of_int (185)) + (Prims.of_int (33))))) + (Obj.magic (concatMap f xs)) + (fun uu___1 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> (op_At ()) uu___ uu___1)))) + uu___)))) uu___1 uu___ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (162)) (Prims.of_int (4)) (Prims.of_int (162)) + (Prims.of_int (189)) (Prims.of_int (4)) (Prims.of_int (189)) (Prims.of_int (54))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (162)) (Prims.of_int (55)) (Prims.of_int (186)) + (Prims.of_int (189)) (Prims.of_int (55)) (Prims.of_int (219)) (Prims.of_int (18))))) (Obj.magic (debug @@ -928,13 +1173,13 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (162)) (Prims.of_int (21)) - (Prims.of_int (162)) (Prims.of_int (28))))) + (Prims.of_int (189)) (Prims.of_int (21)) + (Prims.of_int (189)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (162)) (Prims.of_int (30)) - (Prims.of_int (162)) (Prims.of_int (53))))) + (Prims.of_int (189)) (Prims.of_int (30)) + (Prims.of_int (189)) (Prims.of_int (53))))) (Obj.magic (FStar_Tactics_V2_Builtins.dump "")) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -946,13 +1191,13 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (167)) (Prims.of_int (12)) - (Prims.of_int (167)) (Prims.of_int (26))))) + (Prims.of_int (190)) (Prims.of_int (12)) + (Prims.of_int (190)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (168)) (Prims.of_int (4)) - (Prims.of_int (186)) (Prims.of_int (18))))) + (Prims.of_int (193)) (Prims.of_int (4)) + (Prims.of_int (219)) (Prims.of_int (18))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_witness ())) (fun uu___2 -> (fun w -> @@ -962,14 +1207,14 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (168)) (Prims.of_int (4)) - (Prims.of_int (168)) (Prims.of_int (19))))) + (Prims.of_int (193)) (Prims.of_int (4)) + (Prims.of_int (193)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (168)) (Prims.of_int (20)) - (Prims.of_int (186)) (Prims.of_int (18))))) + (Prims.of_int (193)) (Prims.of_int (20)) + (Prims.of_int (219)) (Prims.of_int (18))))) (Obj.magic (maybe_intros ())) (fun uu___2 -> (fun uu___2 -> @@ -979,17 +1224,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (173)) + (Prims.of_int (198)) (Prims.of_int (14)) - (Prims.of_int (173)) - (Prims.of_int (52))))) + (Prims.of_int (198)) + (Prims.of_int (56))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (174)) - (Prims.of_int (4)) - (Prims.of_int (186)) + (Prims.of_int (198)) + (Prims.of_int (59)) + (Prims.of_int (219)) (Prims.of_int (18))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -997,25 +1242,25 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (173)) - (Prims.of_int (40)) - (Prims.of_int (173)) - (Prims.of_int (52))))) + (Prims.of_int (198)) + (Prims.of_int (44)) + (Prims.of_int (198)) + (Prims.of_int (56))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (173)) + (Prims.of_int (198)) (Prims.of_int (14)) - (Prims.of_int (173)) - (Prims.of_int (52))))) + (Prims.of_int (198)) + (Prims.of_int (56))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_env ())) (fun uu___3 -> FStar_Tactics_Effect.lift_div_tac (fun uu___4 -> - FStar_Reflection_V2_Builtins.lookup_attr + FStar_Reflection_V2_Builtins.lookup_attr_ses (FStar_Reflection_V2_Builtins.pack_ln (FStar_Reflection_V2_Data.Tv_FVar (FStar_Reflection_V2_Builtins.pack_fv @@ -1027,35 +1272,104 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (fun uu___3 -> (fun glb -> Obj.magic - (FStar_Tactics_V2_Derived.try_with + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (199)) + (Prims.of_int (14)) + (Prims.of_int (200)) + (Prims.of_int (65))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (201)) + (Prims.of_int (6)) + (Prims.of_int (219)) + (Prims.of_int (18))))) + (Obj.magic + (concatMap + (fun se -> + concatMap + (fun uu___3 -> + (fun fv -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___3 -> + [ + (se, fv)]))) + uu___3) + (sigelt_name se)) + glb)) (fun uu___3 -> - match () with - | () -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range + (fun glb1 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (203)) + (Prims.of_int (6)) + (Prims.of_int (205)) + (Prims.of_int (16))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (207)) + (Prims.of_int (4)) + (Prims.of_int (219)) + (Prims.of_int (18))))) + (FStar_Tactics_Effect.lift_div_tac + (fun uu___3 + -> + { + seen = []; + glb = + glb1; + fuel = + (Prims.of_int (16)) + })) + (fun uu___3 -> + (fun st0 -> + Obj.magic + (FStar_Tactics_V2_Derived.try_with + (fun + uu___3 -> + match () + with + | + () -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (175)) + (Prims.of_int (208)) (Prims.of_int (6)) - (Prims.of_int (175)) - (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range + (Prims.of_int (208)) + (Prims.of_int (20))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (176)) + (Prims.of_int (209)) (Prims.of_int (6)) - (Prims.of_int (176)) + (Prims.of_int (209)) (Prims.of_int (59))))) - (Obj.magic - (tcresolve' [] - glb - (Prims.of_int (16)))) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (debug + (Obj.magic + (tcresolve' + st0)) + (fun + uu___4 -> + (fun + uu___4 -> + Obj.magic + (debug (fun uu___5 -> FStar_Tactics_Effect.tac_bind @@ -1063,9 +1377,9 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (176)) + (Prims.of_int (209)) (Prims.of_int (42)) - (Prims.of_int (176)) + (Prims.of_int (209)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic @@ -1086,50 +1400,51 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = Prims.strcat "Solved to:\n\t" uu___6))))) - uu___4)) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | NoInst -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.tac_bind - ( - FStar_Sealed.seal + uu___4)) + (fun + uu___3 -> + (fun + uu___3 -> + match uu___3 + with + | + NoInst -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (180)) + (Prims.of_int (213)) (Prims.of_int (15)) - (Prims.of_int (183)) + (Prims.of_int (216)) (Prims.of_int (7))))) - ( - FStar_Sealed.seal + (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (180)) + (Prims.of_int (213)) (Prims.of_int (6)) - (Prims.of_int (183)) + (Prims.of_int (216)) (Prims.of_int (7))))) - ( - Obj.magic + (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (181)) + (Prims.of_int (214)) (Prims.of_int (8)) - (Prims.of_int (182)) + (Prims.of_int (215)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (180)) + (Prims.of_int (213)) (Prims.of_int (15)) - (Prims.of_int (183)) + (Prims.of_int (216)) (Prims.of_int (7))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1137,17 +1452,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (182)) + (Prims.of_int (215)) (Prims.of_int (10)) - (Prims.of_int (182)) + (Prims.of_int (215)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (181)) + (Prims.of_int (214)) (Prims.of_int (8)) - (Prims.of_int (182)) + (Prims.of_int (215)) (Prims.of_int (59))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1155,17 +1470,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (182)) + (Prims.of_int (215)) (Prims.of_int (28)) - (Prims.of_int (182)) + (Prims.of_int (215)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (182)) + (Prims.of_int (215)) (Prims.of_int (10)) - (Prims.of_int (182)) + (Prims.of_int (215)) (Prims.of_int (59))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1173,17 +1488,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (182)) + (Prims.of_int (215)) (Prims.of_int (44)) - (Prims.of_int (182)) + (Prims.of_int (215)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (182)) + (Prims.of_int (215)) (Prims.of_int (28)) - (Prims.of_int (182)) + (Prims.of_int (215)) (Prims.of_int (58))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_goal @@ -1220,27 +1535,30 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (fun uu___5 -> [uu___4])))) - ( - fun + (fun uu___4 -> FStar_Tactics_V2_Derived.fail_doc uu___4))) - | FStar_Tactics_Common.TacticFailure - msg -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail_doc - ( - (op_At ()) + | + FStar_Tactics_Common.TacticFailure + msg -> + Obj.magic + (Obj.repr + (FStar_Tactics_V2_Derived.fail_doc + ((op_At + ()) [ FStar_Pprint.arbitrary_string "Typeclass resolution failed"] msg))) - | e -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.raise + | + e -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.raise e))) + uu___3))) + uu___3))) uu___3))) uu___3))) uu___2))) uu___2))) uu___1) let _ = @@ -1277,8 +1595,8 @@ let rec (mk_abs : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (195)) (Prims.of_int (20)) - (Prims.of_int (195)) (Prims.of_int (47))))) + (Prims.of_int (228)) (Prims.of_int (20)) + (Prims.of_int (228)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "dummy" Prims.int_zero @@ -1289,17 +1607,17 @@ let rec (mk_abs : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (195)) + (Prims.of_int (228)) (Prims.of_int (30)) - (Prims.of_int (195)) + (Prims.of_int (228)) (Prims.of_int (46))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (195)) + (Prims.of_int (228)) (Prims.of_int (20)) - (Prims.of_int (195)) + (Prims.of_int (228)) (Prims.of_int (47))))) (Obj.magic (mk_abs bs1 body)) (fun uu___ -> @@ -1358,12 +1676,12 @@ let (mk_class : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (219)) (Prims.of_int (13)) (Prims.of_int (219)) + (Prims.of_int (252)) (Prims.of_int (13)) (Prims.of_int (252)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (219)) (Prims.of_int (29)) (Prims.of_int (309)) + (Prims.of_int (252)) (Prims.of_int (29)) (Prims.of_int (342)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Reflection_V2_Builtins.explode_qn nm)) @@ -1374,27 +1692,27 @@ let (mk_class : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (220)) (Prims.of_int (12)) - (Prims.of_int (220)) (Prims.of_int (38))))) + (Prims.of_int (253)) (Prims.of_int (12)) + (Prims.of_int (253)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (221)) (Prims.of_int (4)) - (Prims.of_int (309)) (Prims.of_int (5))))) + (Prims.of_int (254)) (Prims.of_int (4)) + (Prims.of_int (342)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (220)) (Prims.of_int (23)) - (Prims.of_int (220)) (Prims.of_int (35))))) + (Prims.of_int (253)) (Prims.of_int (23)) + (Prims.of_int (253)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (220)) (Prims.of_int (12)) - (Prims.of_int (220)) (Prims.of_int (38))))) + (Prims.of_int (253)) (Prims.of_int (12)) + (Prims.of_int (253)) (Prims.of_int (38))))) (Obj.magic (FStar_Tactics_V2_Builtins.top_env ())) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac @@ -1409,14 +1727,14 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (221)) (Prims.of_int (4)) - (Prims.of_int (221)) (Prims.of_int (19))))) + (Prims.of_int (254)) (Prims.of_int (4)) + (Prims.of_int (254)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (221)) (Prims.of_int (20)) - (Prims.of_int (309)) (Prims.of_int (5))))) + (Prims.of_int (254)) (Prims.of_int (20)) + (Prims.of_int (342)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard (FStar_Pervasives_Native.uu___is_Some r))) @@ -1428,17 +1746,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (222)) + (Prims.of_int (255)) (Prims.of_int (18)) - (Prims.of_int (222)) + (Prims.of_int (255)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (221)) + (Prims.of_int (254)) (Prims.of_int (20)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> r)) @@ -1453,17 +1771,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (223)) + (Prims.of_int (256)) (Prims.of_int (23)) - (Prims.of_int (223)) + (Prims.of_int (256)) (Prims.of_int (115))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (223)) + (Prims.of_int (256)) (Prims.of_int (118)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> @@ -1488,18 +1806,18 @@ let (mk_class : Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (224)) + (Prims.of_int (257)) (Prims.of_int (13)) - (Prims.of_int (224)) + (Prims.of_int (257)) (Prims.of_int (30))))) (FStar_Sealed.seal ( Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (225)) + (Prims.of_int (258)) (Prims.of_int (4)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (Obj.magic ( @@ -1515,17 +1833,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (225)) + (Prims.of_int (258)) (Prims.of_int (4)) - (Prims.of_int (225)) + (Prims.of_int (258)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (225)) + (Prims.of_int (258)) (Prims.of_int (29)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard @@ -1541,17 +1859,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (226)) + (Prims.of_int (259)) (Prims.of_int (63)) - (Prims.of_int (226)) + (Prims.of_int (259)) (Prims.of_int (65))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (225)) + (Prims.of_int (258)) (Prims.of_int (29)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -1583,17 +1901,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (227)) + (Prims.of_int (260)) (Prims.of_int (4)) - (Prims.of_int (227)) + (Prims.of_int (260)) (Prims.of_int (87))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (228)) + (Prims.of_int (261)) (Prims.of_int (4)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (Obj.magic (debug @@ -1604,9 +1922,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (227)) + (Prims.of_int (260)) (Prims.of_int (35)) - (Prims.of_int (227)) + (Prims.of_int (260)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -1638,17 +1956,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (228)) + (Prims.of_int (261)) (Prims.of_int (4)) - (Prims.of_int (228)) + (Prims.of_int (261)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (229)) + (Prims.of_int (262)) (Prims.of_int (4)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (Obj.magic (debug @@ -1675,17 +1993,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (229)) + (Prims.of_int (262)) (Prims.of_int (4)) - (Prims.of_int (229)) + (Prims.of_int (262)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (229)) + (Prims.of_int (262)) (Prims.of_int (60)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (Obj.magic (debug @@ -1696,9 +2014,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (229)) + (Prims.of_int (262)) (Prims.of_int (40)) - (Prims.of_int (229)) + (Prims.of_int (262)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic @@ -1729,17 +2047,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (230)) + (Prims.of_int (263)) (Prims.of_int (20)) - (Prims.of_int (230)) + (Prims.of_int (263)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (232)) + (Prims.of_int (265)) (Prims.of_int (4)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (Obj.magic (last @@ -1755,17 +2073,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (232)) + (Prims.of_int (265)) (Prims.of_int (4)) - (Prims.of_int (232)) + (Prims.of_int (265)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (232)) + (Prims.of_int (265)) (Prims.of_int (31)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard @@ -1782,17 +2100,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (233)) + (Prims.of_int (266)) (Prims.of_int (25)) - (Prims.of_int (233)) + (Prims.of_int (266)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (232)) + (Prims.of_int (265)) (Prims.of_int (31)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -1814,17 +2132,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (234)) + (Prims.of_int (267)) (Prims.of_int (4)) - (Prims.of_int (234)) + (Prims.of_int (267)) (Prims.of_int (87))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (234)) + (Prims.of_int (267)) (Prims.of_int (88)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (Obj.magic (debug @@ -1835,9 +2153,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (234)) + (Prims.of_int (267)) (Prims.of_int (35)) - (Prims.of_int (234)) + (Prims.of_int (267)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -1853,9 +2171,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (234)) + (Prims.of_int (267)) (Prims.of_int (55)) - (Prims.of_int (234)) + (Prims.of_int (267)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -1871,9 +2189,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (234)) + (Prims.of_int (267)) (Prims.of_int (69)) - (Prims.of_int (234)) + (Prims.of_int (267)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -1927,17 +2245,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (235)) + (Prims.of_int (268)) (Prims.of_int (18)) - (Prims.of_int (235)) + (Prims.of_int (268)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (234)) + (Prims.of_int (267)) (Prims.of_int (88)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_arr_bs @@ -1959,17 +2277,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (236)) + (Prims.of_int (269)) (Prims.of_int (12)) - (Prims.of_int (236)) + (Prims.of_int (269)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (237)) + (Prims.of_int (270)) (Prims.of_int (4)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -1988,17 +2306,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (237)) + (Prims.of_int (270)) (Prims.of_int (4)) - (Prims.of_int (237)) + (Prims.of_int (270)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (237)) + (Prims.of_int (270)) (Prims.of_int (23)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard @@ -2016,17 +2334,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (238)) + (Prims.of_int (271)) (Prims.of_int (22)) - (Prims.of_int (238)) + (Prims.of_int (271)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (237)) + (Prims.of_int (270)) (Prims.of_int (23)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2049,17 +2367,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (240)) + (Prims.of_int (273)) (Prims.of_int (4)) - (Prims.of_int (240)) + (Prims.of_int (273)) (Prims.of_int (87))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (241)) + (Prims.of_int (274)) (Prims.of_int (4)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2071,9 +2389,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (240)) + (Prims.of_int (273)) (Prims.of_int (35)) - (Prims.of_int (240)) + (Prims.of_int (273)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -2109,17 +2427,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (241)) + (Prims.of_int (274)) (Prims.of_int (4)) - (Prims.of_int (241)) + (Prims.of_int (274)) (Prims.of_int (81))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (242)) + (Prims.of_int (275)) (Prims.of_int (4)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2152,17 +2470,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (242)) + (Prims.of_int (275)) (Prims.of_int (4)) - (Prims.of_int (242)) + (Prims.of_int (275)) (Prims.of_int (76))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (243)) + (Prims.of_int (276)) (Prims.of_int (4)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2195,17 +2513,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (243)) + (Prims.of_int (276)) (Prims.of_int (4)) - (Prims.of_int (243)) + (Prims.of_int (276)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (243)) + (Prims.of_int (276)) (Prims.of_int (52)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2217,9 +2535,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (243)) + (Prims.of_int (276)) (Prims.of_int (32)) - (Prims.of_int (243)) + (Prims.of_int (276)) (Prims.of_int (50))))) (FStar_Sealed.seal (Obj.magic @@ -2254,17 +2572,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (247)) + (Prims.of_int (280)) (Prims.of_int (24)) - (Prims.of_int (247)) + (Prims.of_int (280)) (Prims.of_int (61))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (250)) + (Prims.of_int (283)) (Prims.of_int (4)) - (Prims.of_int (309)) + (Prims.of_int (342)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2288,17 +2606,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (252)) + (Prims.of_int (285)) (Prims.of_int (14)) - (Prims.of_int (252)) + (Prims.of_int (285)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (253)) + (Prims.of_int (286)) (Prims.of_int (6)) - (Prims.of_int (308)) + (Prims.of_int (341)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_V2_Derived.name_of_binder @@ -2313,17 +2631,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (253)) + (Prims.of_int (286)) (Prims.of_int (6)) - (Prims.of_int (253)) + (Prims.of_int (286)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (253)) + (Prims.of_int (286)) (Prims.of_int (49)) - (Prims.of_int (308)) + (Prims.of_int (341)) (Prims.of_int (8))))) (Obj.magic (debug @@ -2354,17 +2672,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (254)) + (Prims.of_int (287)) (Prims.of_int (15)) - (Prims.of_int (254)) + (Prims.of_int (287)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (254)) + (Prims.of_int (287)) (Prims.of_int (31)) - (Prims.of_int (308)) + (Prims.of_int (341)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_module @@ -2380,17 +2698,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (255)) + (Prims.of_int (288)) (Prims.of_int (16)) - (Prims.of_int (255)) + (Prims.of_int (288)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (255)) + (Prims.of_int (288)) (Prims.of_int (37)) - (Prims.of_int (308)) + (Prims.of_int (341)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2411,17 +2729,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (256)) + (Prims.of_int (289)) (Prims.of_int (16)) - (Prims.of_int (256)) + (Prims.of_int (289)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (256)) + (Prims.of_int (289)) (Prims.of_int (41)) - (Prims.of_int (308)) + (Prims.of_int (341)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_V2_Derived.fresh_namedv_named @@ -2437,17 +2755,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (257)) + (Prims.of_int (290)) (Prims.of_int (16)) - (Prims.of_int (257)) + (Prims.of_int (290)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (257)) + (Prims.of_int (290)) (Prims.of_int (31)) - (Prims.of_int (308)) + (Prims.of_int (341)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2471,17 +2789,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (259)) + (Prims.of_int (292)) (Prims.of_int (8)) - (Prims.of_int (263)) + (Prims.of_int (296)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (264)) + (Prims.of_int (297)) (Prims.of_int (10)) - (Prims.of_int (308)) + (Prims.of_int (341)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2489,17 +2807,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (261)) + (Prims.of_int (294)) (Prims.of_int (17)) - (Prims.of_int (261)) + (Prims.of_int (294)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (259)) + (Prims.of_int (292)) (Prims.of_int (8)) - (Prims.of_int (263)) + (Prims.of_int (296)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V2_Builtins.fresh @@ -2538,17 +2856,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (265)) + (Prims.of_int (298)) (Prims.of_int (22)) - (Prims.of_int (265)) + (Prims.of_int (298)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (265)) + (Prims.of_int (298)) (Prims.of_int (51)) - (Prims.of_int (308)) + (Prims.of_int (341)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2556,17 +2874,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (265)) + (Prims.of_int (298)) (Prims.of_int (22)) - (Prims.of_int (265)) + (Prims.of_int (298)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (265)) + (Prims.of_int (298)) (Prims.of_int (22)) - (Prims.of_int (265)) + (Prims.of_int (298)) (Prims.of_int (48))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_module @@ -2595,17 +2913,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (266)) + (Prims.of_int (299)) (Prims.of_int (17)) - (Prims.of_int (266)) + (Prims.of_int (299)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (266)) + (Prims.of_int (299)) (Prims.of_int (54)) - (Prims.of_int (308)) + (Prims.of_int (341)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2626,17 +2944,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (269)) + (Prims.of_int (302)) (Prims.of_int (8)) - (Prims.of_int (274)) + (Prims.of_int (307)) (Prims.of_int (50))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (275)) - (Prims.of_int (8)) (Prims.of_int (308)) + (Prims.of_int (8)) + (Prims.of_int (341)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2644,17 +2962,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (269)) + (Prims.of_int (302)) (Prims.of_int (14)) - (Prims.of_int (269)) + (Prims.of_int (302)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (269)) + (Prims.of_int (302)) (Prims.of_int (8)) - (Prims.of_int (274)) + (Prims.of_int (307)) (Prims.of_int (50))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2662,17 +2980,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (269)) + (Prims.of_int (302)) (Prims.of_int (25)) - (Prims.of_int (269)) + (Prims.of_int (302)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (269)) + (Prims.of_int (302)) (Prims.of_int (14)) - (Prims.of_int (269)) + (Prims.of_int (302)) (Prims.of_int (47))))) (Obj.magic (FStar_Tactics_V2_Builtins.top_env @@ -2712,17 +3030,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (272)) + (Prims.of_int (305)) (Prims.of_int (16)) - (Prims.of_int (272)) + (Prims.of_int (305)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (272)) + (Prims.of_int (305)) (Prims.of_int (10)) - (Prims.of_int (274)) + (Prims.of_int (307)) (Prims.of_int (50))))) (Obj.magic (FStar_Tactics_NamedView.inspect_sigelt @@ -2769,17 +3087,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (278)) + (Prims.of_int (311)) (Prims.of_int (14)) - (Prims.of_int (285)) + (Prims.of_int (318)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (286)) + (Prims.of_int (319)) (Prims.of_int (8)) - (Prims.of_int (308)) + (Prims.of_int (341)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2787,17 +3105,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (279)) + (Prims.of_int (312)) (Prims.of_int (22)) - (Prims.of_int (279)) + (Prims.of_int (312)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (278)) + (Prims.of_int (311)) (Prims.of_int (14)) - (Prims.of_int (285)) + (Prims.of_int (318)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_arr_bs @@ -2819,17 +3137,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (280)) + (Prims.of_int (313)) (Prims.of_int (21)) - (Prims.of_int (280)) + (Prims.of_int (313)) (Prims.of_int (75))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (279)) + (Prims.of_int (312)) (Prims.of_int (54)) - (Prims.of_int (285)) + (Prims.of_int (318)) (Prims.of_int (37))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2868,17 +3186,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (284)) + (Prims.of_int (317)) (Prims.of_int (21)) - (Prims.of_int (284)) + (Prims.of_int (317)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (285)) + (Prims.of_int (318)) (Prims.of_int (12)) - (Prims.of_int (285)) + (Prims.of_int (318)) (Prims.of_int (37))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2912,17 +3230,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (287)) + (Prims.of_int (320)) (Prims.of_int (15)) - (Prims.of_int (294)) + (Prims.of_int (327)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (296)) + (Prims.of_int (329)) (Prims.of_int (6)) - (Prims.of_int (308)) + (Prims.of_int (341)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2930,17 +3248,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (288)) + (Prims.of_int (321)) (Prims.of_int (23)) - (Prims.of_int (288)) + (Prims.of_int (321)) (Prims.of_int (49))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (287)) + (Prims.of_int (320)) (Prims.of_int (15)) - (Prims.of_int (294)) + (Prims.of_int (327)) (Prims.of_int (38))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_abs @@ -2962,17 +3280,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (289)) + (Prims.of_int (322)) (Prims.of_int (21)) - (Prims.of_int (289)) + (Prims.of_int (322)) (Prims.of_int (75))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (288)) + (Prims.of_int (321)) (Prims.of_int (52)) - (Prims.of_int (294)) + (Prims.of_int (327)) (Prims.of_int (38))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3011,17 +3329,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (293)) + (Prims.of_int (326)) (Prims.of_int (21)) - (Prims.of_int (293)) + (Prims.of_int (326)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (294)) + (Prims.of_int (327)) (Prims.of_int (12)) - (Prims.of_int (294)) + (Prims.of_int (327)) (Prims.of_int (38))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3055,17 +3373,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (296)) + (Prims.of_int (329)) (Prims.of_int (6)) - (Prims.of_int (296)) + (Prims.of_int (329)) (Prims.of_int (53))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (297)) + (Prims.of_int (330)) (Prims.of_int (6)) - (Prims.of_int (308)) + (Prims.of_int (341)) (Prims.of_int (8))))) (Obj.magic (debug @@ -3077,9 +3395,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (296)) + (Prims.of_int (329)) (Prims.of_int (34)) - (Prims.of_int (296)) + (Prims.of_int (329)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic @@ -3114,17 +3432,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (297)) + (Prims.of_int (330)) (Prims.of_int (6)) - (Prims.of_int (297)) + (Prims.of_int (330)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (297)) + (Prims.of_int (330)) (Prims.of_int (53)) - (Prims.of_int (308)) + (Prims.of_int (341)) (Prims.of_int (8))))) (Obj.magic (debug @@ -3136,9 +3454,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (297)) + (Prims.of_int (330)) (Prims.of_int (34)) - (Prims.of_int (297)) + (Prims.of_int (330)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic @@ -3173,17 +3491,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (299)) + (Prims.of_int (332)) (Prims.of_int (22)) - (Prims.of_int (299)) + (Prims.of_int (332)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (299)) + (Prims.of_int (332)) (Prims.of_int (27)) - (Prims.of_int (308)) + (Prims.of_int (341)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3200,17 +3518,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (300)) + (Prims.of_int (333)) (Prims.of_int (23)) - (Prims.of_int (300)) + (Prims.of_int (333)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (300)) + (Prims.of_int (333)) (Prims.of_int (29)) - (Prims.of_int (308)) + (Prims.of_int (341)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3227,17 +3545,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (301)) + (Prims.of_int (334)) (Prims.of_int (21)) - (Prims.of_int (301)) + (Prims.of_int (334)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (301)) + (Prims.of_int (334)) (Prims.of_int (27)) - (Prims.of_int (308)) + (Prims.of_int (341)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3254,17 +3572,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (303)) + (Prims.of_int (336)) (Prims.of_int (17)) - (Prims.of_int (303)) + (Prims.of_int (336)) (Prims.of_int (70))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (303)) + (Prims.of_int (336)) (Prims.of_int (75)) - (Prims.of_int (308)) + (Prims.of_int (341)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3292,17 +3610,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (304)) + (Prims.of_int (337)) (Prims.of_int (15)) - (Prims.of_int (304)) + (Prims.of_int (337)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (306)) + (Prims.of_int (339)) (Prims.of_int (15)) - (Prims.of_int (306)) + (Prims.of_int (339)) (Prims.of_int (42))))) (Obj.magic (FStar_Tactics_NamedView.pack_sigelt diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Util.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Util.ml index db4dbfb9319..270b05d0ecc 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Util.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Util.ml @@ -709,4 +709,38 @@ let rec string_of_list : FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> Prims.strcat uu___ uu___1)))) uu___)))) + uu___1 uu___ +let string_of_option : + 'a . + ('a -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) -> + 'a FStar_Pervasives_Native.option -> + (Prims.string, unit) FStar_Tactics_Effect.tac_repr + = + fun uu___1 -> + fun uu___ -> + (fun f -> + fun o -> + match o with + | FStar_Pervasives_Native.Some x -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Util.fst" + (Prims.of_int (126)) (Prims.of_int (24)) + (Prims.of_int (126)) (Prims.of_int (27))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "prims.fst" + (Prims.of_int (590)) (Prims.of_int (19)) + (Prims.of_int (590)) (Prims.of_int (31))))) + (Obj.magic (f x)) + (fun uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___1 -> Prims.strcat "Some " uu___)))) + | FStar_Pervasives_Native.None -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> "None")))) uu___1 uu___ \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml index 628eeeee569..40dcddbfd53 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml @@ -2877,16 +2877,19 @@ let (add_se_to_attrtab : env -> FStar_Syntax_Syntax.sigelt -> unit) = FStar_Compiler_Util.smap_add (attrtab env2) attr uu___ in FStar_Compiler_List.iter (fun attr -> - let uu___ = - let uu___1 = FStar_Syntax_Subst.compress attr in - uu___1.FStar_Syntax_Syntax.n in + let uu___ = FStar_Syntax_Util.head_and_args attr in match uu___ with - | FStar_Syntax_Syntax.Tm_fvar fv -> - let uu___1 = - let uu___2 = FStar_Syntax_Syntax.lid_of_fv fv in - FStar_Ident.string_of_lid uu___2 in - add_one env1 se uu___1 - | uu___1 -> ()) se.FStar_Syntax_Syntax.sigattrs + | (hd, uu___1) -> + let uu___2 = + let uu___3 = FStar_Syntax_Subst.compress hd in + uu___3.FStar_Syntax_Syntax.n in + (match uu___2 with + | FStar_Syntax_Syntax.Tm_fvar fv -> + let uu___3 = + let uu___4 = FStar_Syntax_Syntax.lid_of_fv fv in + FStar_Ident.string_of_lid uu___4 in + add_one env1 se uu___3 + | uu___3 -> ())) se.FStar_Syntax_Syntax.sigattrs let (try_add_sigelt : Prims.bool -> env -> FStar_Syntax_Syntax.sigelt -> FStar_Ident.lident -> unit) From 55e312aaad842fe5a473fd394226eec0cae7afaa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 20 Apr 2024 16:35:40 -0700 Subject: [PATCH 049/239] Update expected output --- tests/error-messages/Bug1918.fst.expected | 4 ++-- tests/ide/emacs/fstarmode_gh73.out.expected | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/error-messages/Bug1918.fst.expected b/tests/error-messages/Bug1918.fst.expected index cf82f56aeb7..b53d84b6f9e 100644 --- a/tests/error-messages/Bug1918.fst.expected +++ b/tests/error-messages/Bug1918.fst.expected @@ -1,5 +1,5 @@ proof-state: State dump @ depth 0 (at the time of failure): -Location: FStar.Tactics.Typeclasses.fst(180,6-183,7) +Location: FStar.Tactics.Typeclasses.fst(213,6-216,7) Goal 1/1: |- _ : Bug1918.mon @@ -7,7 +7,7 @@ Goal 1/1: * Error 228 at Bug1918.fst(11,13-11,14): - Tactic failed - Could not solve constraint Bug1918.mon - - See also FStar.Tactics.Typeclasses.fst(180,6-183,7) + - See also FStar.Tactics.Typeclasses.fst(213,6-216,7) >>] Verified module: Bug1918 diff --git a/tests/ide/emacs/fstarmode_gh73.out.expected b/tests/ide/emacs/fstarmode_gh73.out.expected index 963edbeb8aa..6a11645c219 100644 --- a/tests/ide/emacs/fstarmode_gh73.out.expected +++ b/tests/ide/emacs/fstarmode_gh73.out.expected @@ -1,5 +1,5 @@ {"kind": "protocol-info", "rest": "[...]"} -{"kind": "response", "query-id": "1", "response": [{"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(150,0-150,48)\n", "number": 288, "ranges": [{"beg": [135, 17], "end": [135, 24], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [150, 0], "end": [150, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(150,0-150,48)\n", "number": 288, "ranges": [{"beg": [136, 22], "end": [136, 29], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [150, 0], "end": [150, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Adding an implicit 'assume new' qualifier on document\n", "number": 239, "ranges": [{"beg": [36, 5], "end": [36, 13], "fname": "FStar.Stubs.Pprint.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(150,0-150,48)\n", "number": 288, "ranges": [{"beg": [624, 15], "end": [624, 22], "fname": "FStar.Tactics.V2.Derived.fst"}, {"beg": [150, 0], "end": [150, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(150,0-150,48)\n", "number": 288, "ranges": [{"beg": [176, 11], "end": [176, 18], "fname": "FStar.Tactics.V2.Logic.fst"}, {"beg": [150, 0], "end": [150, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Pattern uses these theory symbols or terms that should not be in an smt pattern: Prims.op_Subtraction\n", "number": 271, "ranges": [{"beg": [434, 8], "end": [434, 51], "fname": "FStar.UInt.fsti"}]}], "status": "success"} +{"kind": "response", "query-id": "1", "response": [{"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(160,0-160,48)\n", "number": 288, "ranges": [{"beg": [135, 17], "end": [135, 24], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [160, 0], "end": [160, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(160,0-160,48)\n", "number": 288, "ranges": [{"beg": [136, 22], "end": [136, 29], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [160, 0], "end": [160, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Adding an implicit 'assume new' qualifier on document\n", "number": 239, "ranges": [{"beg": [36, 5], "end": [36, 13], "fname": "FStar.Stubs.Pprint.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(160,0-160,48)\n", "number": 288, "ranges": [{"beg": [624, 15], "end": [624, 22], "fname": "FStar.Tactics.V2.Derived.fst"}, {"beg": [160, 0], "end": [160, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(160,0-160,48)\n", "number": 288, "ranges": [{"beg": [176, 11], "end": [176, 18], "fname": "FStar.Tactics.V2.Logic.fst"}, {"beg": [160, 0], "end": [160, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Pattern uses these theory symbols or terms that should not be in an smt pattern: Prims.op_Subtraction\n", "number": 271, "ranges": [{"beg": [434, 8], "end": [434, 51], "fname": "FStar.UInt.fsti"}]}], "status": "success"} {"kind": "response", "query-id": "2", "response": [{"level": "error", "message": " - Expected expression of type int got expression \"A\" of type string\n", "number": 189, "ranges": [{"beg": [4, 48], "end": [4, 51], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "3", "response": [{"level": "error", "message": " - Expected expression of type int got expression \"A\" of type string\n", "number": 189, "ranges": [{"beg": [4, 48], "end": [4, 51], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "4", "response": [], "status": "success"} From 8ac4ae529d68154c3c48950b850f9f3ebf62dd42 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Sat, 20 Apr 2024 19:36:09 -0700 Subject: [PATCH 050/239] disable compat:injectivity --- .../generated/FStar_SMTEncoding_Encode.ml | 36 ++++++++----------- src/smtencoding/FStar.SMTEncoding.Encode.fst | 17 ++++++--- 2 files changed, 26 insertions(+), 27 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index d881ac473e9..f18f126669d 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -4101,25 +4101,19 @@ let (encode_sig_inductive : "Impossible" else (); (let eqs = - let uu___13 = + if is_injective_on_params - || - (let uu___14 = - FStar_Options.ext_getv - "compat:injectivity" in - uu___14 <> "") in - if uu___13 then FStar_Compiler_List.map2 (fun v -> fun a -> - let uu___14 = - let uu___15 = + let uu___13 = + let uu___14 = FStar_SMTEncoding_Util.mkFreeV v in - (uu___15, a) in + (uu___14, a) in FStar_SMTEncoding_Util.mkEq - uu___14) vars + uu___13) vars indices1 else [] in let uu___13 = @@ -4475,19 +4469,13 @@ let (encode_datacon : env1 in (match uu___6 with | (vars, guards, env', binder_decls, names) -> - let is_injective_on_tparams1 = - is_injective_on_tparams || - (let uu___7 = - FStar_Options.ext_getv - "compat:injectivity" in - uu___7 <> "") in let fields = FStar_Compiler_List.mapi (fun n -> fun x -> let field_projectible = (n >= n_tps) || - is_injective_on_tparams1 in + is_injective_on_tparams in let uu___7 = FStar_SMTEncoding_Env.mk_term_projector_name d x in @@ -4519,7 +4507,7 @@ let (encode_datacon : uu___9; FStar_SMTEncoding_Term.constr_base = (Prims.op_Negation - is_injective_on_tparams1) + is_injective_on_tparams) } in FStar_SMTEncoding_Term.constructor_to_decl uu___7 uu___8 in @@ -4639,7 +4627,7 @@ let (encode_datacon : orig_arg arg xv = if Prims.op_Negation - is_injective_on_tparams1 + is_injective_on_tparams then FStar_SMTEncoding_Util.mkTrue else @@ -5446,7 +5434,7 @@ let (encode_datacon : orig_arg arg xv = if Prims.op_Negation - is_injective_on_tparams1 + is_injective_on_tparams then FStar_SMTEncoding_Util.mkTrue else @@ -7118,7 +7106,11 @@ and (encode_sigelt' : (fun se1 -> FStar_Syntax_Syntax.uu___is_Sig_inductive_typ se1.FStar_Syntax_Syntax.sigel) ses in - let is_injective_on_params = false in + let is_injective_on_params = + match tycon with + | FStar_Pervasives_Native.None -> false + | FStar_Pervasives_Native.Some se1 -> + is_sig_inductive_injective_on_params env se1 in let uu___2 = FStar_Compiler_List.fold_left (fun uu___3 -> diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index 4bcf3944deb..3f2213ade20 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -1116,7 +1116,7 @@ let encode_sig_inductive (is_injective_on_params:bool) (env:env_t) (se:sigelt) then failwith "Impossible"; let eqs = if is_injective_on_params - || Options.ext_getv "compat:injectivity" <> "" + // || Options.ext_getv "compat:injectivity" <> "" then List.map2 (fun v a -> mkEq(mkFreeV v, a)) vars indices else [] // //only injectivity on indices @@ -1228,9 +1228,9 @@ let encode_datacon (is_injective_on_tparams:bool) (env:env_t) (se:sigelt) let fuel_var, fuel_tm = fresh_fvar env.current_module_name "f" Fuel_sort in let s_fuel_tm = mkApp("SFuel", [fuel_tm]) in let vars, guards, env', binder_decls, names = encode_binders (Some fuel_tm) formals env in - let is_injective_on_tparams = - is_injective_on_tparams || Options.ext_getv "compat:injectivity" <> "" - in + // let is_injective_on_tparams = + // is_injective_on_tparams || Options.ext_getv "compat:injectivity" <> "" + // in let fields = names |> List.mapi @@ -1777,7 +1777,14 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = | Sig_bundle {ses} -> let tycon = List.tryFind (fun se -> Sig_inductive_typ? se.sigel) ses in - let is_injective_on_params = false in + let is_injective_on_params = + match tycon with + | None -> + //Exceptions appear as Sig_bundle without an inductive type + false + | Some se -> + is_sig_inductive_injective_on_params env se + in let g, env = ses |> List.fold_left From 21c731423bc903aada1c0942ca2a796acbc8c12b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 20 Apr 2024 16:38:46 -0700 Subject: [PATCH 051/239] Typeclasses: implement a flavor of functional dependencies --- ulib/FStar.Tactics.Typeclasses.fst | 90 ++++++++++++++++++++++++++--- ulib/FStar.Tactics.Typeclasses.fsti | 8 +++ 2 files changed, 91 insertions(+), 7 deletions(-) diff --git a/ulib/FStar.Tactics.Typeclasses.fst b/ulib/FStar.Tactics.Typeclasses.fst index 1352c119b6c..15d4eedc900 100644 --- a/ulib/FStar.Tactics.Typeclasses.fst +++ b/ulib/FStar.Tactics.Typeclasses.fst @@ -41,6 +41,10 @@ let tcclass : unit = () irreducible let tcinstance : unit = () +(* Functional dependencies of a class. *) +irreducible +let fundeps (_ : list int) : unit = () + (* The attribute that marks class fields to signal that no method should be generated for them *) irreducible @@ -57,6 +61,7 @@ noeq type tc_goal = { g : term; head_fv : fv; + args_and_uvars : list (argv & bool); } val fv_eq : fv -> fv -> Tot bool @@ -74,6 +79,13 @@ let rec head_of (t:term) : Tac (option fv) = | Tv_App h _ -> head_of h | v -> None +let hua (t:term) : Tac (option (fv & universes & list argv)) = + let hd, args = collect_app t in + match inspect hd with + | Tv_FVar fv -> Some (fv, [], args) + | Tv_UInst fv us -> Some (fv, us, args) + | _ -> None + let rec res_typ (t:term) : Tac term = match inspect t with | Tv_Arrow _ c -> ( @@ -113,7 +125,60 @@ let sigelt_name (se:sigelt) : list fv = | Stubs.Reflection.V2.Data.Sg_Val nm _ _ -> [pack_fv nm] | _ -> [] -let trywith (st:st_t) (g:tc_goal) (_:option sigelt) (t typ : term) (k : st_t -> Tac unit) : Tac unit = +(* Would be nice to define an unembedding class here.. but it's circular. *) +let unembed_int (t:term) : Tac (option int) = + match inspect_ln t with + | R.Tv_Const (C_Int i) -> Some i + | _ -> None + +let rec unembed_list (#a:Type) (u : term -> Tac (option a)) (t:term) : Tac (option (list a)) = + match hua t with + | Some (fv, _, [(ty, Q_Implicit); (hd, Q_Explicit); (tl, Q_Explicit)]) -> + if implode_qn (inspect_fv fv) = `%Prims.Cons then + match u hd, unembed_list u tl with + | Some hd, Some tl -> Some (hd::tl) + | _ -> None + else + None + | Some (fv, _, [(ty, Q_Implicit)]) -> + if implode_qn (inspect_fv fv) = `%Prims.Nil then + Some [] + else + None + | _ -> + None + +let extract_fundep (se : sigelt) : Tac (option (list int)) = + let attrs = sigelt_attrs se in + let rec aux (attrs : list term) : Tac (option (list int)) = + match attrs with + | [] -> None + | attr::attrs' -> + match collect_app attr with + | hd, [(a0, Q_Explicit)] -> + if FStar.Reflection.V2.TermEq.term_eq hd (`fundeps) then ( + unembed_list unembed_int a0 + ) else + aux attrs' + | _ -> + aux attrs' + in + aux attrs + +let trywith (st:st_t) (g:tc_goal) (t typ : term) (k : st_t -> Tac unit) : Tac unit = + (* Class sigelt *) + let c_se = lookup_typ (cur_env()) (inspect_fv g.head_fv) in + let fundeps = + match c_se with + | Some se -> + extract_fundep se + | None -> None + in + // print ("head_fv = " ^ fv_to_string g.head_fv); + // print ("fundeps = " ^ Util.string_of_option (Util.string_of_list (fun i -> string_of_int i)) fundeps); + let unresolved_args = g.args_and_uvars |> Util.mapi (fun i (_, b) -> if b then [i <: int] else []) |> List.Tot.flatten in + // print ("unresolved_args = " ^ Util.string_of_list (fun i -> string_of_int i) unresolved_args); + match head_of (res_typ typ) with | None -> debug (fun () -> "no head for typ of this? " ^ term_to_string t ^ " typ=" ^ term_to_string typ); @@ -123,7 +188,16 @@ let trywith (st:st_t) (g:tc_goal) (_:option sigelt) (t typ : term) (k : st_t -> raise NoInst; // class mismatch, would be better to not even get here debug (fun () -> "Trying to apply hypothesis/instance: " ^ term_to_string t); (fun () -> + if Cons? unresolved_args && None? fundeps then + fail "Will not continue as there are unresolved args (and no fundeps)" + else if Cons? unresolved_args && Some? fundeps then ( + let Some fundeps = fundeps in + debug (fun () -> "checking fundeps"); + let all_good = List.Tot.for_all (fun i -> List.Tot.mem i fundeps) unresolved_args in + if all_good then apply t else fail "fundeps" + ) else ( apply_noinst t + ) ) `seq` (fun () -> debug (fun () -> dump "next"; "apply seems to have worked"); let st = { st with fuel = st.fuel - 1 } in @@ -133,14 +207,14 @@ let local (st:st_t) (g:tc_goal) (k : st_t -> Tac unit) () : Tac unit = debug (fun () -> "local, goal = " ^ term_to_string g.g); let bs = vars_of_env (cur_env ()) in first (fun (b:binding) -> - trywith st g None (pack (Tv_Var b)) b.sort k) + trywith st g (pack (Tv_Var b)) b.sort k) bs let global (st:st_t) (g:tc_goal) (k : st_t -> Tac unit) () : Tac unit = debug (fun () -> "global, goal = " ^ term_to_string g.g); first (fun (se, fv) -> let typ = tc (cur_env()) (pack (Tv_FVar fv)) in // FIXME: a bit slow.. but at least it's a simple fvar - trywith st g (Some se) (pack (Tv_FVar fv)) typ k) + trywith st g (pack (Tv_FVar fv)) typ k) st.glb (* @@ -168,15 +242,16 @@ let rec tcresolve' (st:st_t) : Tac unit = raise NoInst ); - match head_of g with + match hua g with | None -> debug (fun () -> "Goal does not look like a typeclass"); raise NoInst - | Some head_fv -> + | Some (head_fv, us, args) -> + let args_and_uvars = args |> Util.map (fun (a, q) -> (a, q), Cons? (free_uvars a )) in (* ^ Maybe should check is this really is a class too? *) let st = { st with seen = g :: st.seen } in - let g = { g = g; head_fv = head_fv; } in + let g = { g = g; head_fv = head_fv; args_and_uvars = args_and_uvars } in local st g tcresolve' `or_else` global st g tcresolve' let rec concatMap (f : 'a -> Tac (list 'b)) (l : list 'a) : Tac (list 'b) = @@ -197,7 +272,8 @@ let tcresolve () : Tac unit = // stored. let glb = lookup_attr_ses (`tcinstance) (cur_env ()) in let glb = glb |> concatMap (fun se -> - sigelt_name se |> concatMap (fun fv -> [(se, fv)])) + sigelt_name se |> concatMap (fun fv -> [(se, fv)]) + ) in let st0 = { seen = []; diff --git a/ulib/FStar.Tactics.Typeclasses.fsti b/ulib/FStar.Tactics.Typeclasses.fsti index 9b41f7ef6a3..eac4b77fc7b 100644 --- a/ulib/FStar.Tactics.Typeclasses.fsti +++ b/ulib/FStar.Tactics.Typeclasses.fsti @@ -24,6 +24,14 @@ val tcclass : unit (* The attribute that marks instances *) val tcinstance : unit +(* Functional dependencies of a class. It takes an int list +representing the arguments of the class (starting from 0, both explicit +and implicit alike) that are dependent on the rest. When trying to apply +an instance, if the fundeps are unresolved (i.e. contain uvars) but the +other arguments do not, we will apply the instance and instantiate the +fundeps. *) +val fundeps : list int -> unit + (* The attribute that marks class fields to signal that no method should be generated for them *) val no_method : unit From ecd76ce45b2348486605ea029eefd4e30ca92e78 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 20 Apr 2024 09:58:26 -0700 Subject: [PATCH 052/239] Tc: allow tcresolve to run for open problems --- src/typechecker/FStar.TypeChecker.Rel.fst | 61 +++++++++++++++++------ 1 file changed, 45 insertions(+), 16 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.Rel.fst b/src/typechecker/FStar.TypeChecker.Rel.fst index 9c0465f5a2a..ba34924307b 100644 --- a/src/typechecker/FStar.TypeChecker.Rel.fst +++ b/src/typechecker/FStar.TypeChecker.Rel.fst @@ -5460,7 +5460,19 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) g (1 + 1) we cannot reuse the solution for each +, since there is an extra unit binder when we check `g ...`. But it does lead to big gains in expressions like `1 + 1 + 1 ...`. *) - let cacheable tac = U.is_fvar PC.tcresolve_lid tac in + let cacheable tac = + (* Detect either an unapplied tcresolve or an eta expanded variant. This is + mostly in support of solve, which has to be written eta expanded. *) + (U.is_fvar PC.tcresolve_lid tac) || ( + match (SS.compress tac).n with + | Tm_abs ({bs=[_]; body}) -> + let hd, args = U.head_and_args body in + U.is_fvar PC.tcresolve_lid hd && List.length args = 1 + | _ -> false + ) + in + (* tcresolve is also the only tactic we ever run for an open problem. *) + let meta_tac_allowed_for_open_problem tac = cacheable tac in let __meta_arg_cache : ref (list (term & env_t & typ & term)) = BU.mk_ref [] in let meta_arg_cache_result (tac : term) (e : env_t) (ty : term) (res : term) : unit = __meta_arg_cache := (tac, e, ty, res) :: !__meta_arg_cache @@ -5480,23 +5492,35 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) in (* / cache *) - let rec until_fixpoint (acc : tagged_implicits & (*changed:*)bool) + let rec until_fixpoint (acc : tagged_implicits & (*changed:*)bool & (*defer_open_metas:*)bool ) (implicits:Env.implicits) : tagged_implicits = - let out, changed = acc in + let out, changed, defer_open_metas = acc in + (* changed: we made some progress + defer_open_metas: starts at true, it means to not try to run + meta arg tactics in environments/types that have unresolved + uvars. We first do a pass with this set to true, and if nothing + changed, we then give up and set it to false, trying to eagerly + solve some partially-unresolved constraints. This is definitely + not ideal, maybe the right thing to do is to never run metas + in open contexts, but that is raising many regressions rihgt now, + particularly in Steel (which uses the resolve_implicits hook pervasively). *) match implicits with | [] -> if changed then ( (* We made some progress, keep going from the start *) - until_fixpoint ([], false) (List.map fst out) + until_fixpoint ([], false, true) (List.map fst out) + ) else if defer_open_metas then ( + (* No progress... but we could try being more eager with metas. *) + until_fixpoint ([], false, false) (List.map fst out) ) else ( //Nothing changed in this iteration of the loop //We will try to make progress by either solving a single valued implicit, // or solving an implicit that generates univ constraint, with force flag on let imps, changed = try_solve_single_valued_implicits env is_tac (List.map fst out) in - if changed then until_fixpoint ([], false) imps + if changed then until_fixpoint ([], false, true) imps else let imp_opt, rest = pick_a_univ_deffered_implicit out in (match imp_opt with | None -> rest //No such implicit exists, return remaining implicits @@ -5508,7 +5532,7 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) imp is_tac force_univ_constraints |> must in - until_fixpoint ([], false) (imps@List.map fst rest)) + until_fixpoint ([], false, true) (imps@List.map fst rest)) ) | hd::tl -> @@ -5519,20 +5543,25 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) (show tm) (show ctx_u) (show is_tac) (show uvar_decoration_should_check); begin match () with | _ when Allow_unresolved? uvar_decoration_should_check -> - until_fixpoint (out, true) tl + until_fixpoint (out, true, defer_open_metas) tl | _ when unresolved ctx_u && flex_uvar_has_meta_tac ctx_u -> let Some (Ctx_uvar_meta_tac tac) = ctx_u.ctx_uvar_meta in let env = { env with gamma = ctx_u.ctx_uvar_gamma } in let typ = U.ctx_uvar_typ ctx_u in - if (has_free_uvars typ || gamma_has_free_uvars ctx_u.ctx_uvar_gamma) + let is_open = has_free_uvars typ || gamma_has_free_uvars ctx_u.ctx_uvar_gamma in + if defer_open_metas && is_open && Options.ext_getv "compat:open_metas" = "" then // i.e. compat option unset ( (* If the result type or env for this meta arg has a free uvar, delay it. Some other meta arg being solved may instantiate the uvar. See #3130. *) if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "Imps" then BU.print1 "Deferring implicit due to open ctx/typ %s\n" (show ctx_u); - until_fixpoint ((hd, Implicit_unresolved)::out, changed) tl + until_fixpoint ((hd, Implicit_unresolved)::out, changed, defer_open_metas) tl + ) else if is_open && not (meta_tac_allowed_for_open_problem tac) then ( + (* If the tactic is not explicitly whitelisted to run with open problems, + then defer. *) + until_fixpoint ((hd, Implicit_unresolved)::out, changed, defer_open_metas) tl ) else ( let solve_with (t:term) = let extra = @@ -5540,7 +5569,7 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) | None -> failwith "resolve_implicits: unifying with an unresolved uvar failed?" | Some g -> g.implicits in - until_fixpoint (out, true) (extra @ tl) + until_fixpoint (out, true, defer_open_metas) (extra @ tl) in if cacheable tac then match meta_arg_cache_lookup tac env typ with @@ -5555,12 +5584,12 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) ) | _ when unresolved ctx_u -> - until_fixpoint ((hd, Implicit_unresolved)::out, changed) tl + until_fixpoint ((hd, Implicit_unresolved)::out, changed, defer_open_metas) tl | _ when Allow_untyped? uvar_decoration_should_check || Already_checked? uvar_decoration_should_check || is_gen -> - until_fixpoint (out, true) tl + until_fixpoint (out, true, defer_open_metas) tl | _ -> let env = {env with gamma=ctx_u.ctx_uvar_gamma} in (* @@ -5583,7 +5612,7 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) then failwith "Impossible: check_implicit_solution_and_discharge_guard for tac must return Some []" else () else (); - until_fixpoint (out, true) tl + until_fixpoint (out, true, defer_open_metas) tl end else begin @@ -5597,14 +5626,14 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) match imps_opt with | None -> - until_fixpoint ((hd, Implicit_checking_defers_univ_constraint)::out, changed) tl //Move hd to out + until_fixpoint ((hd, Implicit_checking_defers_univ_constraint)::out, changed, defer_open_metas) tl //Move hd to out | Some imps -> //add imps to out - until_fixpoint ((imps |> List.map (fun i -> i, Implicit_unresolved))@out, true) tl + until_fixpoint ((imps |> List.map (fun i -> i, Implicit_unresolved))@out, true, defer_open_metas) tl end end in - until_fixpoint ([], false) implicits + until_fixpoint ([], false, true) implicits let resolve_implicits env g = if Env.debug env <| Options.Other "ResolveImplicitsHook" From ca809d35e50fa7c0afb3a1e801b8d9656a5f3f2e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 20 Apr 2024 22:36:17 -0700 Subject: [PATCH 053/239] snap --- .../generated/FStar_Tactics_Typeclasses.ml | 1988 +++++++++++------ .../generated/FStar_TypeChecker_Rel.ml | 205 +- 2 files changed, 1459 insertions(+), 734 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml index 7a450af4589..4d82c641815 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml @@ -67,11 +67,19 @@ let (__proj__Mkst_t__item__fuel : st_t -> Prims.int) = type tc_goal = { g: FStar_Tactics_NamedView.term ; - head_fv: FStar_Reflection_Types.fv } + head_fv: FStar_Reflection_Types.fv ; + args_and_uvars: (FStar_Reflection_V2_Data.argv * Prims.bool) Prims.list } let (__proj__Mktc_goal__item__g : tc_goal -> FStar_Tactics_NamedView.term) = - fun projectee -> match projectee with | { g; head_fv;_} -> g + fun projectee -> + match projectee with | { g; head_fv; args_and_uvars;_} -> g let (__proj__Mktc_goal__item__head_fv : tc_goal -> FStar_Reflection_Types.fv) - = fun projectee -> match projectee with | { g; head_fv;_} -> head_fv + = + fun projectee -> + match projectee with | { g; head_fv; args_and_uvars;_} -> head_fv +let (__proj__Mktc_goal__item__args_and_uvars : + tc_goal -> (FStar_Reflection_V2_Data.argv * Prims.bool) Prims.list) = + fun projectee -> + match projectee with | { g; head_fv; args_and_uvars;_} -> args_and_uvars let (fv_eq : FStar_Reflection_Types.fv -> FStar_Reflection_Types.fv -> Prims.bool) = fun fv1 -> @@ -88,12 +96,12 @@ let rec (head_of : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (71)) (Prims.of_int (8)) (Prims.of_int (71)) + (Prims.of_int (76)) (Prims.of_int (8)) (Prims.of_int (76)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (71)) (Prims.of_int (2)) (Prims.of_int (75)) + (Prims.of_int (76)) (Prims.of_int (2)) (Prims.of_int (80)) (Prims.of_int (13))))) (Obj.magic (FStar_Tactics_NamedView.inspect t)) (fun uu___ -> @@ -116,6 +124,55 @@ let rec (head_of : (Obj.repr (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> FStar_Pervasives_Native.None)))) uu___) +let (hua : + FStar_Tactics_NamedView.term -> + ((FStar_Reflection_Types.fv * FStar_Reflection_V2_Data.universes * + FStar_Reflection_V2_Data.argv Prims.list) + FStar_Pervasives_Native.option, + unit) FStar_Tactics_Effect.tac_repr) + = + fun t -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (83)) (Prims.of_int (17)) (Prims.of_int (83)) + (Prims.of_int (30))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (82)) (Prims.of_int (62)) (Prims.of_int (87)) + (Prims.of_int (13))))) + (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_app t)) + (fun uu___ -> + (fun uu___ -> + match uu___ with + | (hd, args) -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (84)) (Prims.of_int (8)) + (Prims.of_int (84)) (Prims.of_int (18))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (84)) (Prims.of_int (2)) + (Prims.of_int (87)) (Prims.of_int (13))))) + (Obj.magic (FStar_Tactics_NamedView.inspect hd)) + (fun uu___1 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> + match uu___1 with + | FStar_Tactics_NamedView.Tv_FVar fv -> + FStar_Pervasives_Native.Some (fv, [], args) + | FStar_Tactics_NamedView.Tv_UInst (fv, us) -> + FStar_Pervasives_Native.Some (fv, us, args) + | uu___3 -> FStar_Pervasives_Native.None)))) + uu___) let rec (res_typ : FStar_Tactics_NamedView.term -> (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) @@ -125,12 +182,12 @@ let rec (res_typ : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (78)) (Prims.of_int (8)) (Prims.of_int (78)) + (Prims.of_int (90)) (Prims.of_int (8)) (Prims.of_int (90)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (78)) (Prims.of_int (2)) (Prims.of_int (84)) + (Prims.of_int (90)) (Prims.of_int (2)) (Prims.of_int (96)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_NamedView.inspect t)) (fun uu___ -> @@ -176,12 +233,12 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (99)) (Prims.of_int (10)) (Prims.of_int (99)) + (Prims.of_int (111)) (Prims.of_int (10)) (Prims.of_int (111)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (100)) (Prims.of_int (2)) (Prims.of_int (104)) + (Prims.of_int (112)) (Prims.of_int (2)) (Prims.of_int (116)) (Prims.of_int (11))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_goal ())) (fun uu___1 -> @@ -191,13 +248,13 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (100)) (Prims.of_int (8)) - (Prims.of_int (100)) (Prims.of_int (17))))) + (Prims.of_int (112)) (Prims.of_int (8)) + (Prims.of_int (112)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (100)) (Prims.of_int (2)) - (Prims.of_int (104)) (Prims.of_int (11))))) + (Prims.of_int (112)) (Prims.of_int (2)) + (Prims.of_int (116)) (Prims.of_int (11))))) (Obj.magic (FStar_Tactics_NamedView.inspect g)) (fun uu___1 -> (fun uu___1 -> @@ -210,17 +267,17 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (102)) + (Prims.of_int (114)) (Prims.of_int (4)) - (Prims.of_int (102)) + (Prims.of_int (114)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (103)) + (Prims.of_int (115)) (Prims.of_int (4)) - (Prims.of_int (103)) + (Prims.of_int (115)) (Prims.of_int (19))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -228,17 +285,17 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (102)) + (Prims.of_int (114)) (Prims.of_int (11)) - (Prims.of_int (102)) + (Prims.of_int (114)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (102)) + (Prims.of_int (114)) (Prims.of_int (4)) - (Prims.of_int (102)) + (Prims.of_int (114)) (Prims.of_int (21))))) (Obj.magic (FStar_Tactics_V2_Builtins.intro @@ -266,331 +323,856 @@ let (sigelt_name : | FStar_Reflection_V2_Data.Sg_Val (nm, uu___, uu___1) -> [FStar_Reflection_V2_Builtins.pack_fv nm] | uu___ -> [] -let (trywith : - st_t -> - tc_goal -> - FStar_Reflection_Types.sigelt FStar_Pervasives_Native.option -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - (st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) -> - (unit, unit) FStar_Tactics_Effect.tac_repr) +let (unembed_int : + FStar_Tactics_NamedView.term -> + (Prims.int FStar_Pervasives_Native.option, unit) + FStar_Tactics_Effect.tac_repr) = - fun st -> - fun g -> - fun uu___ -> - fun t -> - fun typ -> - fun k -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (117)) (Prims.of_int (10)) - (Prims.of_int (117)) (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (117)) (Prims.of_int (4)) - (Prims.of_int (130)) (Prims.of_int (13))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (117)) (Prims.of_int (18)) - (Prims.of_int (117)) (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (117)) (Prims.of_int (10)) - (Prims.of_int (117)) (Prims.of_int (31))))) - (Obj.magic (res_typ typ)) - (fun uu___1 -> - (fun uu___1 -> Obj.magic (head_of uu___1)) uu___1))) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStar_Pervasives_Native.None -> - Obj.magic + fun uu___ -> + (fun t -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> + match FStar_Reflection_V2_Builtins.inspect_ln t with + | FStar_Reflection_V2_Data.Tv_Const + (FStar_Reflection_V2_Data.C_Int i) -> + FStar_Pervasives_Native.Some i + | uu___1 -> FStar_Pervasives_Native.None))) uu___ +let rec unembed_list : + 'a . + (FStar_Tactics_NamedView.term -> + ('a FStar_Pervasives_Native.option, unit) + FStar_Tactics_Effect.tac_repr) + -> + FStar_Tactics_NamedView.term -> + ('a Prims.list FStar_Pervasives_Native.option, unit) + FStar_Tactics_Effect.tac_repr + = + fun u -> + fun t -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (135)) (Prims.of_int (8)) (Prims.of_int (135)) + (Prims.of_int (13))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (135)) (Prims.of_int (2)) (Prims.of_int (149)) + (Prims.of_int (8))))) (Obj.magic (hua t)) + (fun uu___ -> + (fun uu___ -> + match uu___ with + | FStar_Pervasives_Native.Some + (fv, uu___1, + (ty, FStar_Reflection_V2_Data.Q_Implicit)::(hd, + FStar_Reflection_V2_Data.Q_Explicit):: + (tl, FStar_Reflection_V2_Data.Q_Explicit)::[]) + -> + Obj.magic + (Obj.repr + (if + (FStar_Reflection_V2_Builtins.implode_qn + (FStar_Reflection_V2_Builtins.inspect_fv fv)) + = "Prims.Cons" + then + Obj.repr (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (119)) - (Prims.of_int (6)) - (Prims.of_int (119)) - (Prims.of_int (104))))) + (Prims.of_int (138)) + (Prims.of_int (12)) + (Prims.of_int (138)) + (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (120)) + (Prims.of_int (138)) (Prims.of_int (6)) - (Prims.of_int (120)) - (Prims.of_int (18))))) + (Prims.of_int (140)) + (Prims.of_int (17))))) (Obj.magic - (debug + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (138)) + (Prims.of_int (12)) + (Prims.of_int (138)) + (Prims.of_int (16))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (138)) + (Prims.of_int (12)) + (Prims.of_int (138)) + (Prims.of_int (35))))) + (Obj.magic (u hd)) (fun uu___2 -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (119)) - (Prims.of_int (53)) - (Prims.of_int (119)) - (Prims.of_int (103))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "prims.fst" - (Prims.of_int (590)) - (Prims.of_int (19)) - (Prims.of_int (590)) - (Prims.of_int (31))))) - (Obj.magic + (fun uu___2 -> + Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (119)) - (Prims.of_int (53)) - (Prims.of_int (119)) - (Prims.of_int (69))))) + (Prims.of_int (138)) + (Prims.of_int (18)) + (Prims.of_int (138)) + (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (119)) - (Prims.of_int (53)) - (Prims.of_int (119)) - (Prims.of_int (103))))) + (Prims.of_int (138)) + (Prims.of_int (12)) + (Prims.of_int (138)) + (Prims.of_int (35))))) (Obj.magic - (FStar_Tactics_V2_Builtins.term_to_string - t)) + (unembed_list u tl)) (fun uu___3 -> - (fun uu___3 -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal + FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> + (uu___2, uu___3))))) + uu___2))) + (fun uu___2 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> + match uu___2 with + | (FStar_Pervasives_Native.Some hd1, + FStar_Pervasives_Native.Some tl1) + -> + FStar_Pervasives_Native.Some (hd1 + :: tl1) + | uu___4 -> + FStar_Pervasives_Native.None))) + else + Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> FStar_Pervasives_Native.None)))) + | FStar_Pervasives_Native.Some + (fv, uu___1, (ty, FStar_Reflection_V2_Data.Q_Implicit)::[]) + -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> + if + (FStar_Reflection_V2_Builtins.implode_qn + (FStar_Reflection_V2_Builtins.inspect_fv fv)) + = "Prims.Nil" + then FStar_Pervasives_Native.Some [] + else FStar_Pervasives_Native.None))) + | uu___1 -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> FStar_Pervasives_Native.None)))) + uu___) +let (extract_fundep : + FStar_Reflection_Types.sigelt -> + (Prims.int Prims.list FStar_Pervasives_Native.option, unit) + FStar_Tactics_Effect.tac_repr) + = + fun se -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (152)) (Prims.of_int (14)) (Prims.of_int (152)) + (Prims.of_int (29))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (152)) (Prims.of_int (32)) (Prims.of_int (166)) + (Prims.of_int (13))))) + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> FStar_Reflection_V2_Builtins.sigelt_attrs se)) + (fun uu___ -> + (fun attrs -> + let rec aux uu___ = + (fun attrs1 -> + match attrs1 with + | [] -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> FStar_Pervasives_Native.None))) + | attr::attrs' -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (157)) + (Prims.of_int (12)) + (Prims.of_int (157)) + (Prims.of_int (28))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (157)) + (Prims.of_int (12)) + (Prims.of_int (157)) + (Prims.of_int (28))))) + (Obj.magic + (FStar_Tactics_V2_SyntaxHelpers.collect_app + attr)) + (fun uu___ -> + (fun uu___ -> + match uu___ with + | (hd, + (a0, + FStar_Reflection_V2_Data.Q_Explicit)::[]) + -> + if + FStar_Reflection_V2_TermEq.term_eq + hd + (FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; + "Tactics"; + "Typeclasses"; + "fundeps"]))) + then + Obj.magic + (unembed_list unembed_int a0) + else Obj.magic (aux attrs') + | uu___1 -> Obj.magic (aux attrs')) uu___)))) + uu___ in + Obj.magic (aux attrs)) uu___) +let (trywith : + st_t -> + tc_goal -> + FStar_Tactics_NamedView.term -> + FStar_Tactics_NamedView.term -> + (st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) -> + (unit, unit) FStar_Tactics_Effect.tac_repr) + = + fun st -> + fun g -> + fun t -> + fun typ -> + fun k -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (170)) (Prims.of_int (15)) + (Prims.of_int (170)) (Prims.of_int (60))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (170)) (Prims.of_int (63)) + (Prims.of_int (204)) (Prims.of_int (13))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (170)) (Prims.of_int (26)) + (Prims.of_int (170)) (Prims.of_int (37))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (170)) (Prims.of_int (15)) + (Prims.of_int (170)) (Prims.of_int (60))))) + (Obj.magic (FStar_Tactics_V2_Derived.cur_env ())) + (fun uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___1 -> + FStar_Reflection_V2_Builtins.lookup_typ uu___ + (FStar_Reflection_V2_Builtins.inspect_fv + g.head_fv))))) + (fun uu___ -> + (fun c_se -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (172)) (Prims.of_int (6)) + (Prims.of_int (175)) (Prims.of_int (20))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (176)) (Prims.of_int (6)) + (Prims.of_int (204)) (Prims.of_int (13))))) + (match c_se with + | FStar_Pervasives_Native.Some se -> + Obj.magic (Obj.repr (extract_fundep se)) + | FStar_Pervasives_Native.None -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> + FStar_Pervasives_Native.None)))) + (fun uu___ -> + (fun fundeps -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (179)) + (Prims.of_int (26)) + (Prims.of_int (179)) + (Prims.of_int (122))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (182)) + (Prims.of_int (4)) + (Prims.of_int (204)) + (Prims.of_int (13))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (179)) + (Prims.of_int (26)) + (Prims.of_int (179)) + (Prims.of_int (102))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (179)) + (Prims.of_int (26)) + (Prims.of_int (179)) + (Prims.of_int (122))))) + (Obj.magic + (FStar_Tactics_Util.mapi + (fun uu___1 -> + fun uu___ -> + (fun i -> + fun uu___ -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___1 -> + match uu___ + with + | (uu___2, + b) -> + if b + then [i] + else []))) + uu___1 uu___) + g.args_and_uvars)) + (fun uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___1 -> + FStar_List_Tot_Base.flatten + uu___)))) + (fun uu___ -> + (fun unresolved_args -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (182)) + (Prims.of_int (10)) + (Prims.of_int (182)) + (Prims.of_int (31))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (182)) + (Prims.of_int (4)) + (Prims.of_int (204)) + (Prims.of_int (13))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (182)) + (Prims.of_int (18)) + (Prims.of_int (182)) + (Prims.of_int (31))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (182)) + (Prims.of_int (10)) + (Prims.of_int (182)) + (Prims.of_int (31))))) + (Obj.magic (res_typ typ)) + (fun uu___ -> + (fun uu___ -> + Obj.magic + (head_of uu___)) + uu___))) + (fun uu___ -> + (fun uu___ -> + match uu___ with + | FStar_Pervasives_Native.None + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + ( + FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (184)) + (Prims.of_int (6)) + (Prims.of_int (184)) + (Prims.of_int (104))))) + (FStar_Sealed.seal + (Obj.magic + ( + FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (185)) + (Prims.of_int (6)) + (Prims.of_int (185)) + (Prims.of_int (18))))) (Obj.magic - (FStar_Range.mk_range + (debug + ( + fun + uu___1 -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (184)) + (Prims.of_int (53)) + (Prims.of_int (184)) + (Prims.of_int (103))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "prims.fst" + (Prims.of_int (590)) + (Prims.of_int (19)) + (Prims.of_int (590)) + (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (184)) + (Prims.of_int (53)) + (Prims.of_int (184)) + (Prims.of_int (69))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (119)) + (Prims.of_int (184)) + (Prims.of_int (53)) + (Prims.of_int (184)) + (Prims.of_int (103))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string + t)) + (fun + uu___2 -> + (fun + uu___2 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (184)) (Prims.of_int (72)) - (Prims.of_int (119)) + (Prims.of_int (184)) (Prims.of_int (103))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "prims.fst" (Prims.of_int (590)) (Prims.of_int (19)) (Prims.of_int (590)) (Prims.of_int (31))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (184)) + (Prims.of_int (85)) + (Prims.of_int (184)) + (Prims.of_int (103))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "prims.fst" + (Prims.of_int (590)) + (Prims.of_int (19)) + (Prims.of_int (590)) + (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string + typ)) + (fun + uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___4 -> + Prims.strcat + " typ=" + uu___3)))) + (fun + uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___4 -> + Prims.strcat + uu___2 + uu___3)))) + uu___2))) + (fun + uu___2 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___3 -> + Prims.strcat + "no head for typ of this? " + uu___2))))) + (fun uu___1 -> + FStar_Tactics_Effect.raise + NoInst)) + | FStar_Pervasives_Native.Some + fv' -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + ( + FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (187)) + (Prims.of_int (6)) + (Prims.of_int (188)) + (Prims.of_int (20))))) + (FStar_Sealed.seal + (Obj.magic ( + FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (189)) + (Prims.of_int (6)) + (Prims.of_int (204)) + (Prims.of_int (13))))) + (if + Prims.op_Negation + (fv_eq fv' + g.head_fv) + then + FStar_Tactics_Effect.raise + NoInst + else + FStar_Tactics_Effect.lift_div_tac + (fun + uu___2 -> + ())) + (fun uu___1 -> + (fun uu___1 + -> Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (189)) + (Prims.of_int (6)) + (Prims.of_int (189)) + (Prims.of_int (82))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (190)) + (Prims.of_int (6)) + (Prims.of_int (204)) + (Prims.of_int (13))))) + (Obj.magic + (debug + (fun + uu___2 -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (189)) + (Prims.of_int (65)) + (Prims.of_int (189)) + (Prims.of_int (81))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "prims.fst" + (Prims.of_int (590)) + (Prims.of_int (19)) + (Prims.of_int (590)) + (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string + t)) + (fun + uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___4 -> + Prims.strcat + "Trying to apply hypothesis/instance: " + uu___3))))) + (fun + uu___2 -> + (fun + uu___2 -> + Obj.magic + (FStar_Tactics_V2_Derived.seq + (fun + uu___3 -> + (fun + uu___3 -> + if + (Prims.uu___is_Cons + unresolved_args) + && + (FStar_Pervasives_Native.uu___is_None + fundeps) + then + Obj.magic + (Obj.repr + (FStar_Tactics_V2_Derived.fail + "Will not continue as there are unresolved args (and no fundeps)")) + else + Obj.magic + (Obj.repr + (if + (Prims.uu___is_Cons + unresolved_args) + && + (FStar_Pervasives_Native.uu___is_Some + fundeps) + then + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (194)) + (Prims.of_int (29)) + (Prims.of_int (194)) + (Prims.of_int (36))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (193)) + (Prims.of_int (60)) + (Prims.of_int (198)) + (Prims.of_int (9))))) + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___5 -> + fundeps)) + (fun + uu___5 -> + (fun + uu___5 -> + match uu___5 + with + | + FStar_Pervasives_Native.Some + fundeps1 + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (195)) + (Prims.of_int (10)) + (Prims.of_int (195)) + (Prims.of_int (46))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (195)) + (Prims.of_int (47)) + (Prims.of_int (197)) + (Prims.of_int (54))))) + (Obj.magic + (debug + (fun + uu___6 -> + (fun + uu___6 -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___7 -> + "checking fundeps"))) + uu___6))) + (fun + uu___6 -> + (fun + uu___6 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (196)) + (Prims.of_int (25)) + (Prims.of_int (196)) + (Prims.of_int (91))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (197)) + (Prims.of_int (10)) + (Prims.of_int (197)) + (Prims.of_int (54))))) + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___7 -> + FStar_List_Tot_Base.for_all + (fun i -> + FStar_List_Tot_Base.mem + i + fundeps1) + unresolved_args)) + (fun + uu___7 -> + (fun + all_good + -> + if + all_good + then + Obj.magic + (Obj.repr + (FStar_Tactics_V2_Derived.apply + t)) + else + Obj.magic + (Obj.repr + (FStar_Tactics_V2_Derived.fail + "fundeps"))) + uu___7))) + uu___6))) + uu___5) + else + FStar_Tactics_V2_Derived.apply_noinst + t))) + uu___3) + (fun + uu___3 -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (119)) - (Prims.of_int (85)) - (Prims.of_int (119)) - (Prims.of_int (103))))) - (FStar_Sealed.seal - ( - Obj.magic + (Prims.of_int (202)) + (Prims.of_int (8)) + (Prims.of_int (202)) + (Prims.of_int (67))))) + (FStar_Sealed.seal + (Obj.magic (FStar_Range.mk_range - "prims.fst" - (Prims.of_int (590)) - (Prims.of_int (19)) - (Prims.of_int (590)) - (Prims.of_int (31))))) - (Obj.magic - ( - FStar_Tactics_V2_Builtins.term_to_string - typ)) - (fun uu___4 - -> - FStar_Tactics_Effect.lift_div_tac + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (202)) + (Prims.of_int (68)) + (Prims.of_int (204)) + (Prims.of_int (12))))) + (Obj.magic + (debug (fun - uu___5 -> - Prims.strcat - " typ=" - uu___4)))) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 - -> - Prims.strcat - uu___3 - uu___4)))) - uu___3))) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - Prims.strcat - "no head for typ of this? " - uu___3))))) - (fun uu___2 -> - FStar_Tactics_Effect.raise NoInst)) - | FStar_Pervasives_Native.Some fv' -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (122)) - (Prims.of_int (6)) - (Prims.of_int (123)) - (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (124)) - (Prims.of_int (6)) - (Prims.of_int (130)) - (Prims.of_int (13))))) - (if Prims.op_Negation (fv_eq fv' g.head_fv) - then FStar_Tactics_Effect.raise NoInst - else - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> ())) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (124)) - (Prims.of_int (6)) - (Prims.of_int (124)) - (Prims.of_int (82))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (125)) - (Prims.of_int (6)) - (Prims.of_int (130)) - (Prims.of_int (13))))) - (Obj.magic - (debug - (fun uu___3 -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (124)) - (Prims.of_int (65)) - (Prims.of_int (124)) - (Prims.of_int (81))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "prims.fst" - (Prims.of_int (590)) - (Prims.of_int (19)) - (Prims.of_int (590)) - (Prims.of_int (31))))) - (Obj.magic - (FStar_Tactics_V2_Builtins.term_to_string - t)) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - Prims.strcat - "Trying to apply hypothesis/instance: " - uu___4))))) - (fun uu___3 -> - (fun uu___3 -> - Obj.magic - (FStar_Tactics_V2_Derived.seq - (fun uu___4 -> - FStar_Tactics_V2_Derived.apply_noinst - t) - (fun uu___4 -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (128)) - (Prims.of_int (8)) - (Prims.of_int (128)) - (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (128)) - (Prims.of_int (68)) - (Prims.of_int (130)) - (Prims.of_int (12))))) - (Obj.magic - (debug - (fun uu___5 - -> - FStar_Tactics_Effect.tac_bind + uu___4 -> + FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (128)) + (Prims.of_int (202)) (Prims.of_int (25)) - (Prims.of_int (128)) + (Prims.of_int (202)) (Prims.of_int (36))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (128)) + (Prims.of_int (202)) (Prims.of_int (38)) - (Prims.of_int (128)) + (Prims.of_int (202)) (Prims.of_int (66))))) (Obj.magic (FStar_Tactics_V2_Builtins.dump "next")) (fun - uu___6 -> + uu___5 -> FStar_Tactics_Effect.lift_div_tac (fun - uu___7 -> + uu___6 -> "apply seems to have worked"))))) - (fun uu___5 -> - (fun uu___5 -> - Obj.magic - (FStar_Tactics_Effect.tac_bind + (fun + uu___4 -> + (fun + uu___4 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (129)) + (Prims.of_int (203)) (Prims.of_int (19)) - (Prims.of_int (129)) + (Prims.of_int (203)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (130)) + (Prims.of_int (204)) (Prims.of_int (8)) - (Prims.of_int (130)) + (Prims.of_int (204)) (Prims.of_int (12))))) (FStar_Tactics_Effect.lift_div_tac (fun - uu___6 -> + uu___5 -> { seen = (st.seen); @@ -602,14 +1184,17 @@ let (trywith : Prims.int_one) })) (fun - uu___6 -> + uu___5 -> (fun st1 -> Obj.magic (k st1)) - uu___6))) - uu___5)))) - uu___3))) uu___2))) uu___1) + uu___5))) + uu___4)))) + uu___2))) + uu___1))) + uu___))) uu___))) uu___))) + uu___) let (local : st_t -> tc_goal -> @@ -624,13 +1209,13 @@ let (local : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (133)) (Prims.of_int (4)) - (Prims.of_int (133)) (Prims.of_int (59))))) + (Prims.of_int (207)) (Prims.of_int (4)) + (Prims.of_int (207)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (133)) (Prims.of_int (60)) - (Prims.of_int (137)) (Prims.of_int (12))))) + (Prims.of_int (207)) (Prims.of_int (60)) + (Prims.of_int (211)) (Prims.of_int (12))))) (Obj.magic (debug (fun uu___1 -> @@ -639,8 +1224,8 @@ let (local : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (133)) (Prims.of_int (40)) - (Prims.of_int (133)) (Prims.of_int (58))))) + (Prims.of_int (207)) (Prims.of_int (40)) + (Prims.of_int (207)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "prims.fst" @@ -660,31 +1245,31 @@ let (local : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (134)) (Prims.of_int (13)) - (Prims.of_int (134)) (Prims.of_int (37))))) + (Prims.of_int (208)) (Prims.of_int (13)) + (Prims.of_int (208)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (135)) (Prims.of_int (4)) - (Prims.of_int (137)) (Prims.of_int (12))))) + (Prims.of_int (209)) (Prims.of_int (4)) + (Prims.of_int (211)) (Prims.of_int (12))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (134)) + (Prims.of_int (208)) (Prims.of_int (25)) - (Prims.of_int (134)) + (Prims.of_int (208)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (134)) + (Prims.of_int (208)) (Prims.of_int (13)) - (Prims.of_int (134)) + (Prims.of_int (208)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_env ())) (fun uu___2 -> @@ -698,7 +1283,6 @@ let (local : (first (fun b -> trywith st g - FStar_Pervasives_Native.None (FStar_Tactics_NamedView.pack (FStar_Tactics_NamedView.Tv_Var (FStar_Tactics_V2_SyntaxCoercions.binding_to_namedv @@ -719,13 +1303,13 @@ let (global : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (140)) (Prims.of_int (4)) - (Prims.of_int (140)) (Prims.of_int (60))))) + (Prims.of_int (214)) (Prims.of_int (4)) + (Prims.of_int (214)) (Prims.of_int (60))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (141)) (Prims.of_int (4)) - (Prims.of_int (144)) (Prims.of_int (16))))) + (Prims.of_int (215)) (Prims.of_int (4)) + (Prims.of_int (218)) (Prims.of_int (16))))) (Obj.magic (debug (fun uu___1 -> @@ -734,8 +1318,8 @@ let (global : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (140)) (Prims.of_int (41)) - (Prims.of_int (140)) (Prims.of_int (59))))) + (Prims.of_int (214)) (Prims.of_int (41)) + (Prims.of_int (214)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "prims.fst" @@ -759,35 +1343,35 @@ let (global : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (142)) + (Prims.of_int (216)) (Prims.of_int (24)) - (Prims.of_int (142)) + (Prims.of_int (216)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (143)) + (Prims.of_int (217)) (Prims.of_int (14)) - (Prims.of_int (143)) - (Prims.of_int (62))))) + (Prims.of_int (217)) + (Prims.of_int (52))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (142)) + (Prims.of_int (216)) (Prims.of_int (27)) - (Prims.of_int (142)) + (Prims.of_int (216)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (142)) + (Prims.of_int (216)) (Prims.of_int (24)) - (Prims.of_int (142)) + (Prims.of_int (216)) (Prims.of_int (58))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_env ())) @@ -803,7 +1387,6 @@ let (global : (fun typ -> Obj.magic (trywith st g - (FStar_Pervasives_Native.Some se) (FStar_Tactics_NamedView.pack (FStar_Tactics_NamedView.Tv_FVar fv)) typ k)) uu___3)) @@ -814,12 +1397,12 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (158)) (Prims.of_int (4)) (Prims.of_int (159)) + (Prims.of_int (232)) (Prims.of_int (4)) (Prims.of_int (233)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (160)) (Prims.of_int (4)) (Prims.of_int (180)) + (Prims.of_int (234)) (Prims.of_int (4)) (Prims.of_int (255)) (Prims.of_int (60))))) (if st.fuel <= Prims.int_zero then FStar_Tactics_Effect.raise NoInst @@ -831,13 +1414,13 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (160)) (Prims.of_int (4)) - (Prims.of_int (160)) (Prims.of_int (55))))) + (Prims.of_int (234)) (Prims.of_int (4)) + (Prims.of_int (234)) (Prims.of_int (55))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (162)) (Prims.of_int (4)) - (Prims.of_int (180)) (Prims.of_int (60))))) + (Prims.of_int (236)) (Prims.of_int (4)) + (Prims.of_int (255)) (Prims.of_int (60))))) (Obj.magic (debug (fun uu___1 -> @@ -856,14 +1439,14 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (162)) (Prims.of_int (4)) - (Prims.of_int (162)) (Prims.of_int (18))))) + (Prims.of_int (236)) (Prims.of_int (4)) + (Prims.of_int (236)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (162)) (Prims.of_int (19)) - (Prims.of_int (180)) (Prims.of_int (60))))) + (Prims.of_int (236)) (Prims.of_int (19)) + (Prims.of_int (255)) (Prims.of_int (60))))) (Obj.magic (maybe_intros ())) (fun uu___2 -> (fun uu___2 -> @@ -873,17 +1456,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (163)) + (Prims.of_int (237)) (Prims.of_int (12)) - (Prims.of_int (163)) + (Prims.of_int (237)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (166)) + (Prims.of_int (240)) (Prims.of_int (4)) - (Prims.of_int (180)) + (Prims.of_int (255)) (Prims.of_int (60))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_goal @@ -896,17 +1479,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (166)) + (Prims.of_int (240)) (Prims.of_int (4)) - (Prims.of_int (169)) + (Prims.of_int (243)) (Prims.of_int (5))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (171)) + (Prims.of_int (245)) (Prims.of_int (4)) - (Prims.of_int (180)) + (Prims.of_int (255)) (Prims.of_int (60))))) (if FStar_List_Tot_Base.existsb @@ -920,17 +1503,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (167)) + (Prims.of_int (241)) (Prims.of_int (6)) - (Prims.of_int (167)) + (Prims.of_int (241)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (168)) + (Prims.of_int (242)) (Prims.of_int (6)) - (Prims.of_int (168)) + (Prims.of_int (242)) (Prims.of_int (18))))) (Obj.magic (debug @@ -961,20 +1544,20 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (171)) + (Prims.of_int (245)) (Prims.of_int (10)) - (Prims.of_int (171)) - (Prims.of_int (19))))) + (Prims.of_int (245)) + (Prims.of_int (15))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (171)) + (Prims.of_int (245)) (Prims.of_int (4)) - (Prims.of_int (180)) + (Prims.of_int (255)) (Prims.of_int (60))))) (Obj.magic - (head_of g)) + (hua g)) (fun uu___4 -> (fun uu___4 -> @@ -989,17 +1572,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (173)) + (Prims.of_int (247)) (Prims.of_int (6)) - (Prims.of_int (173)) + (Prims.of_int (247)) (Prims.of_int (61))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (174)) + (Prims.of_int (248)) (Prims.of_int (6)) - (Prims.of_int (174)) + (Prims.of_int (248)) (Prims.of_int (18))))) (Obj.magic (debug @@ -1019,7 +1602,92 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = NoInst)) | FStar_Pervasives_Native.Some - head_fv + (head_fv, + us, args) + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (251)) + (Prims.of_int (27)) + (Prims.of_int (251)) + (Prims.of_int (89))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (251)) + (Prims.of_int (92)) + (Prims.of_int (255)) + (Prims.of_int (60))))) + (Obj.magic + (FStar_Tactics_Util.map + (fun + uu___5 -> + match uu___5 + with + | + (a, q) -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (251)) + (Prims.of_int (67)) + (Prims.of_int (251)) + (Prims.of_int (88))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (251)) + (Prims.of_int (59)) + (Prims.of_int (251)) + (Prims.of_int (88))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (251)) + (Prims.of_int (73)) + (Prims.of_int (251)) + (Prims.of_int (88))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (251)) + (Prims.of_int (67)) + (Prims.of_int (251)) + (Prims.of_int (88))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.free_uvars + a)) + (fun + uu___6 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___7 -> + Prims.uu___is_Cons + uu___6)))) + (fun + uu___6 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___7 -> + ((a, q), + uu___6)))) + args)) + (fun + uu___5 -> + (fun + args_and_uvars -> Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1027,17 +1695,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (178)) + (Prims.of_int (253)) (Prims.of_int (17)) - (Prims.of_int (178)) + (Prims.of_int (253)) (Prims.of_int (44))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (178)) + (Prims.of_int (253)) (Prims.of_int (49)) - (Prims.of_int (180)) + (Prims.of_int (255)) (Prims.of_int (60))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -1061,24 +1729,25 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (179)) + (Prims.of_int (254)) (Prims.of_int (16)) - (Prims.of_int (179)) - (Prims.of_int (41))))) + (Prims.of_int (254)) + (Prims.of_int (73))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (180)) + (Prims.of_int (255)) (Prims.of_int (6)) - (Prims.of_int (180)) + (Prims.of_int (255)) (Prims.of_int (60))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___5 -> { g; - head_fv + head_fv; + args_and_uvars })) (fun uu___5 -> @@ -1094,6 +1763,7 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = tcresolve'))) uu___5))) uu___5))) + uu___5))) uu___4))) uu___3))) uu___3))) uu___2))) uu___1))) uu___) @@ -1119,14 +1789,14 @@ let rec concatMap : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (185)) (Prims.of_int (13)) - (Prims.of_int (185)) (Prims.of_int (16))))) + (Prims.of_int (260)) (Prims.of_int (13)) + (Prims.of_int (260)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (185)) (Prims.of_int (13)) - (Prims.of_int (185)) (Prims.of_int (33))))) + (Prims.of_int (260)) (Prims.of_int (13)) + (Prims.of_int (260)) (Prims.of_int (33))))) (Obj.magic (f x)) (fun uu___ -> (fun uu___ -> @@ -1136,17 +1806,17 @@ let rec concatMap : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (185)) + (Prims.of_int (260)) (Prims.of_int (19)) - (Prims.of_int (185)) + (Prims.of_int (260)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (185)) + (Prims.of_int (260)) (Prims.of_int (13)) - (Prims.of_int (185)) + (Prims.of_int (260)) (Prims.of_int (33))))) (Obj.magic (concatMap f xs)) (fun uu___1 -> @@ -1159,12 +1829,12 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (189)) (Prims.of_int (4)) (Prims.of_int (189)) + (Prims.of_int (264)) (Prims.of_int (4)) (Prims.of_int (264)) (Prims.of_int (54))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (189)) (Prims.of_int (55)) (Prims.of_int (219)) + (Prims.of_int (264)) (Prims.of_int (55)) (Prims.of_int (295)) (Prims.of_int (18))))) (Obj.magic (debug @@ -1173,13 +1843,13 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (189)) (Prims.of_int (21)) - (Prims.of_int (189)) (Prims.of_int (28))))) + (Prims.of_int (264)) (Prims.of_int (21)) + (Prims.of_int (264)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (189)) (Prims.of_int (30)) - (Prims.of_int (189)) (Prims.of_int (53))))) + (Prims.of_int (264)) (Prims.of_int (30)) + (Prims.of_int (264)) (Prims.of_int (53))))) (Obj.magic (FStar_Tactics_V2_Builtins.dump "")) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -1191,13 +1861,13 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (190)) (Prims.of_int (12)) - (Prims.of_int (190)) (Prims.of_int (26))))) + (Prims.of_int (265)) (Prims.of_int (12)) + (Prims.of_int (265)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (193)) (Prims.of_int (4)) - (Prims.of_int (219)) (Prims.of_int (18))))) + (Prims.of_int (268)) (Prims.of_int (4)) + (Prims.of_int (295)) (Prims.of_int (18))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_witness ())) (fun uu___2 -> (fun w -> @@ -1207,14 +1877,14 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (193)) (Prims.of_int (4)) - (Prims.of_int (193)) (Prims.of_int (19))))) + (Prims.of_int (268)) (Prims.of_int (4)) + (Prims.of_int (268)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (193)) (Prims.of_int (20)) - (Prims.of_int (219)) (Prims.of_int (18))))) + (Prims.of_int (268)) (Prims.of_int (20)) + (Prims.of_int (295)) (Prims.of_int (18))))) (Obj.magic (maybe_intros ())) (fun uu___2 -> (fun uu___2 -> @@ -1224,17 +1894,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (198)) + (Prims.of_int (273)) (Prims.of_int (14)) - (Prims.of_int (198)) + (Prims.of_int (273)) (Prims.of_int (56))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (198)) + (Prims.of_int (273)) (Prims.of_int (59)) - (Prims.of_int (219)) + (Prims.of_int (295)) (Prims.of_int (18))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1242,17 +1912,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (198)) + (Prims.of_int (273)) (Prims.of_int (44)) - (Prims.of_int (198)) + (Prims.of_int (273)) (Prims.of_int (56))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (198)) + (Prims.of_int (273)) (Prims.of_int (14)) - (Prims.of_int (198)) + (Prims.of_int (273)) (Prims.of_int (56))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_env @@ -1277,17 +1947,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (199)) + (Prims.of_int (274)) (Prims.of_int (14)) - (Prims.of_int (200)) - (Prims.of_int (65))))) + (Prims.of_int (276)) + (Prims.of_int (5))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (201)) + (Prims.of_int (277)) (Prims.of_int (6)) - (Prims.of_int (219)) + (Prims.of_int (295)) (Prims.of_int (18))))) (Obj.magic (concatMap @@ -1312,17 +1982,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (203)) + (Prims.of_int (279)) (Prims.of_int (6)) - (Prims.of_int (205)) + (Prims.of_int (281)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (207)) + (Prims.of_int (283)) (Prims.of_int (4)) - (Prims.of_int (219)) + (Prims.of_int (295)) (Prims.of_int (18))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___3 @@ -1349,17 +2019,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (208)) + (Prims.of_int (284)) (Prims.of_int (6)) - (Prims.of_int (208)) + (Prims.of_int (284)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (209)) + (Prims.of_int (285)) (Prims.of_int (6)) - (Prims.of_int (209)) + (Prims.of_int (285)) (Prims.of_int (59))))) (Obj.magic (tcresolve' @@ -1377,9 +2047,9 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (209)) + (Prims.of_int (285)) (Prims.of_int (42)) - (Prims.of_int (209)) + (Prims.of_int (285)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic @@ -1416,17 +2086,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (213)) + (Prims.of_int (289)) (Prims.of_int (15)) - (Prims.of_int (216)) + (Prims.of_int (292)) (Prims.of_int (7))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (213)) + (Prims.of_int (289)) (Prims.of_int (6)) - (Prims.of_int (216)) + (Prims.of_int (292)) (Prims.of_int (7))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1434,17 +2104,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (214)) + (Prims.of_int (290)) (Prims.of_int (8)) - (Prims.of_int (215)) + (Prims.of_int (291)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (213)) + (Prims.of_int (289)) (Prims.of_int (15)) - (Prims.of_int (216)) + (Prims.of_int (292)) (Prims.of_int (7))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1452,17 +2122,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (215)) + (Prims.of_int (291)) (Prims.of_int (10)) - (Prims.of_int (215)) + (Prims.of_int (291)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (214)) + (Prims.of_int (290)) (Prims.of_int (8)) - (Prims.of_int (215)) + (Prims.of_int (291)) (Prims.of_int (59))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1470,17 +2140,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (215)) + (Prims.of_int (291)) (Prims.of_int (28)) - (Prims.of_int (215)) + (Prims.of_int (291)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (215)) + (Prims.of_int (291)) (Prims.of_int (10)) - (Prims.of_int (215)) + (Prims.of_int (291)) (Prims.of_int (59))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1488,17 +2158,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (215)) + (Prims.of_int (291)) (Prims.of_int (44)) - (Prims.of_int (215)) + (Prims.of_int (291)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (215)) + (Prims.of_int (291)) (Prims.of_int (28)) - (Prims.of_int (215)) + (Prims.of_int (291)) (Prims.of_int (58))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_goal @@ -1595,8 +2265,8 @@ let rec (mk_abs : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (228)) (Prims.of_int (20)) - (Prims.of_int (228)) (Prims.of_int (47))))) + (Prims.of_int (304)) (Prims.of_int (20)) + (Prims.of_int (304)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "dummy" Prims.int_zero @@ -1607,17 +2277,17 @@ let rec (mk_abs : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (228)) + (Prims.of_int (304)) (Prims.of_int (30)) - (Prims.of_int (228)) + (Prims.of_int (304)) (Prims.of_int (46))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (228)) + (Prims.of_int (304)) (Prims.of_int (20)) - (Prims.of_int (228)) + (Prims.of_int (304)) (Prims.of_int (47))))) (Obj.magic (mk_abs bs1 body)) (fun uu___ -> @@ -1676,12 +2346,12 @@ let (mk_class : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (252)) (Prims.of_int (13)) (Prims.of_int (252)) + (Prims.of_int (328)) (Prims.of_int (13)) (Prims.of_int (328)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (252)) (Prims.of_int (29)) (Prims.of_int (342)) + (Prims.of_int (328)) (Prims.of_int (29)) (Prims.of_int (418)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Reflection_V2_Builtins.explode_qn nm)) @@ -1692,27 +2362,27 @@ let (mk_class : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (253)) (Prims.of_int (12)) - (Prims.of_int (253)) (Prims.of_int (38))))) + (Prims.of_int (329)) (Prims.of_int (12)) + (Prims.of_int (329)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (254)) (Prims.of_int (4)) - (Prims.of_int (342)) (Prims.of_int (5))))) + (Prims.of_int (330)) (Prims.of_int (4)) + (Prims.of_int (418)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (253)) (Prims.of_int (23)) - (Prims.of_int (253)) (Prims.of_int (35))))) + (Prims.of_int (329)) (Prims.of_int (23)) + (Prims.of_int (329)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (253)) (Prims.of_int (12)) - (Prims.of_int (253)) (Prims.of_int (38))))) + (Prims.of_int (329)) (Prims.of_int (12)) + (Prims.of_int (329)) (Prims.of_int (38))))) (Obj.magic (FStar_Tactics_V2_Builtins.top_env ())) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac @@ -1727,14 +2397,14 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (254)) (Prims.of_int (4)) - (Prims.of_int (254)) (Prims.of_int (19))))) + (Prims.of_int (330)) (Prims.of_int (4)) + (Prims.of_int (330)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (254)) (Prims.of_int (20)) - (Prims.of_int (342)) (Prims.of_int (5))))) + (Prims.of_int (330)) (Prims.of_int (20)) + (Prims.of_int (418)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard (FStar_Pervasives_Native.uu___is_Some r))) @@ -1746,17 +2416,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (255)) + (Prims.of_int (331)) (Prims.of_int (18)) - (Prims.of_int (255)) + (Prims.of_int (331)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (254)) + (Prims.of_int (330)) (Prims.of_int (20)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> r)) @@ -1771,17 +2441,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (256)) + (Prims.of_int (332)) (Prims.of_int (23)) - (Prims.of_int (256)) + (Prims.of_int (332)) (Prims.of_int (115))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (256)) + (Prims.of_int (332)) (Prims.of_int (118)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> @@ -1806,18 +2476,18 @@ let (mk_class : Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (257)) + (Prims.of_int (333)) (Prims.of_int (13)) - (Prims.of_int (257)) + (Prims.of_int (333)) (Prims.of_int (30))))) (FStar_Sealed.seal ( Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (258)) + (Prims.of_int (334)) (Prims.of_int (4)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (Obj.magic ( @@ -1833,17 +2503,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (258)) + (Prims.of_int (334)) (Prims.of_int (4)) - (Prims.of_int (258)) + (Prims.of_int (334)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (258)) + (Prims.of_int (334)) (Prims.of_int (29)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard @@ -1859,17 +2529,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (259)) + (Prims.of_int (335)) (Prims.of_int (63)) - (Prims.of_int (259)) + (Prims.of_int (335)) (Prims.of_int (65))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (258)) + (Prims.of_int (334)) (Prims.of_int (29)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -1901,17 +2571,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (260)) + (Prims.of_int (336)) (Prims.of_int (4)) - (Prims.of_int (260)) + (Prims.of_int (336)) (Prims.of_int (87))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (261)) + (Prims.of_int (337)) (Prims.of_int (4)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (Obj.magic (debug @@ -1922,9 +2592,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (260)) + (Prims.of_int (336)) (Prims.of_int (35)) - (Prims.of_int (260)) + (Prims.of_int (336)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -1956,17 +2626,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (261)) + (Prims.of_int (337)) (Prims.of_int (4)) - (Prims.of_int (261)) + (Prims.of_int (337)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (262)) + (Prims.of_int (338)) (Prims.of_int (4)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (Obj.magic (debug @@ -1993,17 +2663,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (262)) + (Prims.of_int (338)) (Prims.of_int (4)) - (Prims.of_int (262)) + (Prims.of_int (338)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (262)) + (Prims.of_int (338)) (Prims.of_int (60)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2014,9 +2684,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (262)) + (Prims.of_int (338)) (Prims.of_int (40)) - (Prims.of_int (262)) + (Prims.of_int (338)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic @@ -2047,17 +2717,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (263)) + (Prims.of_int (339)) (Prims.of_int (20)) - (Prims.of_int (263)) + (Prims.of_int (339)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (265)) + (Prims.of_int (341)) (Prims.of_int (4)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (Obj.magic (last @@ -2073,17 +2743,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (265)) + (Prims.of_int (341)) (Prims.of_int (4)) - (Prims.of_int (265)) + (Prims.of_int (341)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (265)) + (Prims.of_int (341)) (Prims.of_int (31)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard @@ -2100,17 +2770,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (266)) + (Prims.of_int (342)) (Prims.of_int (25)) - (Prims.of_int (266)) + (Prims.of_int (342)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (265)) + (Prims.of_int (341)) (Prims.of_int (31)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2132,17 +2802,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (267)) + (Prims.of_int (343)) (Prims.of_int (4)) - (Prims.of_int (267)) + (Prims.of_int (343)) (Prims.of_int (87))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (267)) + (Prims.of_int (343)) (Prims.of_int (88)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2153,9 +2823,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (267)) + (Prims.of_int (343)) (Prims.of_int (35)) - (Prims.of_int (267)) + (Prims.of_int (343)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -2171,9 +2841,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (267)) + (Prims.of_int (343)) (Prims.of_int (55)) - (Prims.of_int (267)) + (Prims.of_int (343)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -2189,9 +2859,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (267)) + (Prims.of_int (343)) (Prims.of_int (69)) - (Prims.of_int (267)) + (Prims.of_int (343)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -2245,17 +2915,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (268)) + (Prims.of_int (344)) (Prims.of_int (18)) - (Prims.of_int (268)) + (Prims.of_int (344)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (267)) + (Prims.of_int (343)) (Prims.of_int (88)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_arr_bs @@ -2277,17 +2947,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (269)) + (Prims.of_int (345)) (Prims.of_int (12)) - (Prims.of_int (269)) + (Prims.of_int (345)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (270)) + (Prims.of_int (346)) (Prims.of_int (4)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2306,17 +2976,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (270)) + (Prims.of_int (346)) (Prims.of_int (4)) - (Prims.of_int (270)) + (Prims.of_int (346)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (270)) + (Prims.of_int (346)) (Prims.of_int (23)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard @@ -2334,17 +3004,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (271)) + (Prims.of_int (347)) (Prims.of_int (22)) - (Prims.of_int (271)) + (Prims.of_int (347)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (270)) + (Prims.of_int (346)) (Prims.of_int (23)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2367,17 +3037,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (273)) + (Prims.of_int (349)) (Prims.of_int (4)) - (Prims.of_int (273)) + (Prims.of_int (349)) (Prims.of_int (87))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (274)) + (Prims.of_int (350)) (Prims.of_int (4)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2389,9 +3059,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (273)) + (Prims.of_int (349)) (Prims.of_int (35)) - (Prims.of_int (273)) + (Prims.of_int (349)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -2427,17 +3097,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (274)) + (Prims.of_int (350)) (Prims.of_int (4)) - (Prims.of_int (274)) + (Prims.of_int (350)) (Prims.of_int (81))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (275)) + (Prims.of_int (351)) (Prims.of_int (4)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2470,17 +3140,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (275)) + (Prims.of_int (351)) (Prims.of_int (4)) - (Prims.of_int (275)) + (Prims.of_int (351)) (Prims.of_int (76))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (276)) + (Prims.of_int (352)) (Prims.of_int (4)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2513,17 +3183,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (276)) + (Prims.of_int (352)) (Prims.of_int (4)) - (Prims.of_int (276)) + (Prims.of_int (352)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (276)) + (Prims.of_int (352)) (Prims.of_int (52)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2535,9 +3205,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (276)) + (Prims.of_int (352)) (Prims.of_int (32)) - (Prims.of_int (276)) + (Prims.of_int (352)) (Prims.of_int (50))))) (FStar_Sealed.seal (Obj.magic @@ -2572,17 +3242,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (280)) + (Prims.of_int (356)) (Prims.of_int (24)) - (Prims.of_int (280)) + (Prims.of_int (356)) (Prims.of_int (61))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (283)) + (Prims.of_int (359)) (Prims.of_int (4)) - (Prims.of_int (342)) + (Prims.of_int (418)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2606,17 +3276,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (285)) + (Prims.of_int (361)) (Prims.of_int (14)) - (Prims.of_int (285)) + (Prims.of_int (361)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (286)) + (Prims.of_int (362)) (Prims.of_int (6)) - (Prims.of_int (341)) + (Prims.of_int (417)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_V2_Derived.name_of_binder @@ -2631,17 +3301,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (286)) + (Prims.of_int (362)) (Prims.of_int (6)) - (Prims.of_int (286)) + (Prims.of_int (362)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (286)) + (Prims.of_int (362)) (Prims.of_int (49)) - (Prims.of_int (341)) + (Prims.of_int (417)) (Prims.of_int (8))))) (Obj.magic (debug @@ -2672,17 +3342,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (287)) + (Prims.of_int (363)) (Prims.of_int (15)) - (Prims.of_int (287)) + (Prims.of_int (363)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (287)) + (Prims.of_int (363)) (Prims.of_int (31)) - (Prims.of_int (341)) + (Prims.of_int (417)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_module @@ -2698,17 +3368,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (288)) + (Prims.of_int (364)) (Prims.of_int (16)) - (Prims.of_int (288)) + (Prims.of_int (364)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (288)) + (Prims.of_int (364)) (Prims.of_int (37)) - (Prims.of_int (341)) + (Prims.of_int (417)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2729,17 +3399,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (289)) + (Prims.of_int (365)) (Prims.of_int (16)) - (Prims.of_int (289)) + (Prims.of_int (365)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (289)) + (Prims.of_int (365)) (Prims.of_int (41)) - (Prims.of_int (341)) + (Prims.of_int (417)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_V2_Derived.fresh_namedv_named @@ -2755,17 +3425,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (290)) + (Prims.of_int (366)) (Prims.of_int (16)) - (Prims.of_int (290)) + (Prims.of_int (366)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (290)) + (Prims.of_int (366)) (Prims.of_int (31)) - (Prims.of_int (341)) + (Prims.of_int (417)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2789,17 +3459,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (292)) + (Prims.of_int (368)) (Prims.of_int (8)) - (Prims.of_int (296)) + (Prims.of_int (372)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (297)) + (Prims.of_int (373)) (Prims.of_int (10)) - (Prims.of_int (341)) + (Prims.of_int (417)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2807,17 +3477,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (294)) + (Prims.of_int (370)) (Prims.of_int (17)) - (Prims.of_int (294)) + (Prims.of_int (370)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (292)) + (Prims.of_int (368)) (Prims.of_int (8)) - (Prims.of_int (296)) + (Prims.of_int (372)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V2_Builtins.fresh @@ -2856,17 +3526,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (298)) + (Prims.of_int (374)) (Prims.of_int (22)) - (Prims.of_int (298)) + (Prims.of_int (374)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (298)) + (Prims.of_int (374)) (Prims.of_int (51)) - (Prims.of_int (341)) + (Prims.of_int (417)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2874,17 +3544,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (298)) + (Prims.of_int (374)) (Prims.of_int (22)) - (Prims.of_int (298)) + (Prims.of_int (374)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (298)) + (Prims.of_int (374)) (Prims.of_int (22)) - (Prims.of_int (298)) + (Prims.of_int (374)) (Prims.of_int (48))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_module @@ -2913,17 +3583,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (299)) + (Prims.of_int (375)) (Prims.of_int (17)) - (Prims.of_int (299)) + (Prims.of_int (375)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (299)) + (Prims.of_int (375)) (Prims.of_int (54)) - (Prims.of_int (341)) + (Prims.of_int (417)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2944,17 +3614,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (302)) + (Prims.of_int (378)) (Prims.of_int (8)) - (Prims.of_int (307)) + (Prims.of_int (383)) (Prims.of_int (50))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (308)) + (Prims.of_int (384)) (Prims.of_int (8)) - (Prims.of_int (341)) + (Prims.of_int (417)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2962,17 +3632,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (302)) + (Prims.of_int (378)) (Prims.of_int (14)) - (Prims.of_int (302)) + (Prims.of_int (378)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (302)) + (Prims.of_int (378)) (Prims.of_int (8)) - (Prims.of_int (307)) + (Prims.of_int (383)) (Prims.of_int (50))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2980,17 +3650,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (302)) + (Prims.of_int (378)) (Prims.of_int (25)) - (Prims.of_int (302)) + (Prims.of_int (378)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (302)) + (Prims.of_int (378)) (Prims.of_int (14)) - (Prims.of_int (302)) + (Prims.of_int (378)) (Prims.of_int (47))))) (Obj.magic (FStar_Tactics_V2_Builtins.top_env @@ -3030,17 +3700,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (305)) + (Prims.of_int (381)) (Prims.of_int (16)) - (Prims.of_int (305)) + (Prims.of_int (381)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (305)) + (Prims.of_int (381)) (Prims.of_int (10)) - (Prims.of_int (307)) + (Prims.of_int (383)) (Prims.of_int (50))))) (Obj.magic (FStar_Tactics_NamedView.inspect_sigelt @@ -3087,17 +3757,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (311)) + (Prims.of_int (387)) (Prims.of_int (14)) - (Prims.of_int (318)) + (Prims.of_int (394)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (319)) + (Prims.of_int (395)) (Prims.of_int (8)) - (Prims.of_int (341)) + (Prims.of_int (417)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3105,17 +3775,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (312)) + (Prims.of_int (388)) (Prims.of_int (22)) - (Prims.of_int (312)) + (Prims.of_int (388)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (311)) + (Prims.of_int (387)) (Prims.of_int (14)) - (Prims.of_int (318)) + (Prims.of_int (394)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_arr_bs @@ -3137,17 +3807,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (313)) + (Prims.of_int (389)) (Prims.of_int (21)) - (Prims.of_int (313)) + (Prims.of_int (389)) (Prims.of_int (75))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (312)) + (Prims.of_int (388)) (Prims.of_int (54)) - (Prims.of_int (318)) + (Prims.of_int (394)) (Prims.of_int (37))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3186,17 +3856,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (317)) + (Prims.of_int (393)) (Prims.of_int (21)) - (Prims.of_int (317)) + (Prims.of_int (393)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (318)) + (Prims.of_int (394)) (Prims.of_int (12)) - (Prims.of_int (318)) + (Prims.of_int (394)) (Prims.of_int (37))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3230,17 +3900,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (320)) + (Prims.of_int (396)) (Prims.of_int (15)) - (Prims.of_int (327)) + (Prims.of_int (403)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (329)) + (Prims.of_int (405)) (Prims.of_int (6)) - (Prims.of_int (341)) + (Prims.of_int (417)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3248,17 +3918,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (321)) + (Prims.of_int (397)) (Prims.of_int (23)) - (Prims.of_int (321)) + (Prims.of_int (397)) (Prims.of_int (49))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (320)) + (Prims.of_int (396)) (Prims.of_int (15)) - (Prims.of_int (327)) + (Prims.of_int (403)) (Prims.of_int (38))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_abs @@ -3280,17 +3950,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (322)) + (Prims.of_int (398)) (Prims.of_int (21)) - (Prims.of_int (322)) + (Prims.of_int (398)) (Prims.of_int (75))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (321)) + (Prims.of_int (397)) (Prims.of_int (52)) - (Prims.of_int (327)) + (Prims.of_int (403)) (Prims.of_int (38))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3329,17 +3999,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (326)) + (Prims.of_int (402)) (Prims.of_int (21)) - (Prims.of_int (326)) + (Prims.of_int (402)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (327)) + (Prims.of_int (403)) (Prims.of_int (12)) - (Prims.of_int (327)) + (Prims.of_int (403)) (Prims.of_int (38))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3373,17 +4043,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (329)) + (Prims.of_int (405)) (Prims.of_int (6)) - (Prims.of_int (329)) + (Prims.of_int (405)) (Prims.of_int (53))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (330)) + (Prims.of_int (406)) (Prims.of_int (6)) - (Prims.of_int (341)) + (Prims.of_int (417)) (Prims.of_int (8))))) (Obj.magic (debug @@ -3395,9 +4065,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (329)) + (Prims.of_int (405)) (Prims.of_int (34)) - (Prims.of_int (329)) + (Prims.of_int (405)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic @@ -3432,17 +4102,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (330)) + (Prims.of_int (406)) (Prims.of_int (6)) - (Prims.of_int (330)) + (Prims.of_int (406)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (330)) + (Prims.of_int (406)) (Prims.of_int (53)) - (Prims.of_int (341)) + (Prims.of_int (417)) (Prims.of_int (8))))) (Obj.magic (debug @@ -3454,9 +4124,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (330)) + (Prims.of_int (406)) (Prims.of_int (34)) - (Prims.of_int (330)) + (Prims.of_int (406)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic @@ -3491,17 +4161,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (332)) + (Prims.of_int (408)) (Prims.of_int (22)) - (Prims.of_int (332)) + (Prims.of_int (408)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (332)) + (Prims.of_int (408)) (Prims.of_int (27)) - (Prims.of_int (341)) + (Prims.of_int (417)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3518,17 +4188,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (333)) + (Prims.of_int (409)) (Prims.of_int (23)) - (Prims.of_int (333)) + (Prims.of_int (409)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (333)) + (Prims.of_int (409)) (Prims.of_int (29)) - (Prims.of_int (341)) + (Prims.of_int (417)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3545,17 +4215,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (334)) + (Prims.of_int (410)) (Prims.of_int (21)) - (Prims.of_int (334)) + (Prims.of_int (410)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (334)) + (Prims.of_int (410)) (Prims.of_int (27)) - (Prims.of_int (341)) + (Prims.of_int (417)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3572,17 +4242,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (336)) + (Prims.of_int (412)) (Prims.of_int (17)) - (Prims.of_int (336)) + (Prims.of_int (412)) (Prims.of_int (70))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (336)) + (Prims.of_int (412)) (Prims.of_int (75)) - (Prims.of_int (341)) + (Prims.of_int (417)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3610,17 +4280,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (337)) + (Prims.of_int (413)) (Prims.of_int (15)) - (Prims.of_int (337)) + (Prims.of_int (413)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (339)) + (Prims.of_int (415)) (Prims.of_int (15)) - (Prims.of_int (339)) + (Prims.of_int (415)) (Prims.of_int (42))))) (Obj.magic (FStar_Tactics_NamedView.pack_sigelt diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml index a2e6368f008..cb1495cd91f 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml @@ -15130,7 +15130,26 @@ let (resolve_implicits' : fun is_gen -> fun implicits -> let cacheable tac = - FStar_Syntax_Util.is_fvar FStar_Parser_Const.tcresolve_lid tac in + (FStar_Syntax_Util.is_fvar FStar_Parser_Const.tcresolve_lid tac) + || + (let uu___ = + let uu___1 = FStar_Syntax_Subst.compress tac in + uu___1.FStar_Syntax_Syntax.n in + match uu___ with + | FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = uu___1::[]; + FStar_Syntax_Syntax.body = body; + FStar_Syntax_Syntax.rc_opt = uu___2;_} + -> + let uu___3 = FStar_Syntax_Util.head_and_args body in + (match uu___3 with + | (hd, args) -> + (FStar_Syntax_Util.is_fvar + FStar_Parser_Const.tcresolve_lid hd) + && + ((FStar_Compiler_List.length args) = Prims.int_one)) + | uu___1 -> false) in + let meta_tac_allowed_for_open_problem tac = cacheable tac in let __meta_arg_cache = FStar_Compiler_Util.mk_ref [] in let meta_arg_cache_result tac e ty res = let uu___ = @@ -15154,7 +15173,7 @@ let (resolve_implicits' : let rec until_fixpoint acc implicits1 = let uu___ = acc in match uu___ with - | (out, changed) -> + | (out, changed, defer_open_metas) -> (match implicits1 with | [] -> if changed @@ -15162,39 +15181,49 @@ let (resolve_implicits' : let uu___1 = FStar_Compiler_List.map FStar_Pervasives_Native.fst out in - until_fixpoint ([], false) uu___1 + until_fixpoint ([], false, true) uu___1 else - (let uu___2 = - let uu___3 = + if defer_open_metas + then + (let uu___2 = FStar_Compiler_List.map FStar_Pervasives_Native.fst out in - try_solve_single_valued_implicits env is_tac uu___3 in - match uu___2 with - | (imps, changed1) -> - if changed1 - then until_fixpoint ([], false) imps - else - (let uu___4 = pick_a_univ_deffered_implicit out in - match uu___4 with - | (imp_opt, rest) -> - (match imp_opt with - | FStar_Pervasives_Native.None -> rest - | FStar_Pervasives_Native.Some imp -> - let force_univ_constraints = true in - let imps1 = - let uu___5 = - check_implicit_solution_and_discharge_guard - env imp is_tac - force_univ_constraints in - FStar_Compiler_Util.must uu___5 in - let uu___5 = + until_fixpoint ([], false, false) uu___2) + else + (let uu___3 = + let uu___4 = + FStar_Compiler_List.map + FStar_Pervasives_Native.fst out in + try_solve_single_valued_implicits env is_tac + uu___4 in + match uu___3 with + | (imps, changed1) -> + if changed1 + then until_fixpoint ([], false, true) imps + else + (let uu___5 = + pick_a_univ_deffered_implicit out in + match uu___5 with + | (imp_opt, rest) -> + (match imp_opt with + | FStar_Pervasives_Native.None -> rest + | FStar_Pervasives_Native.Some imp -> + let force_univ_constraints = true in + let imps1 = + let uu___6 = + check_implicit_solution_and_discharge_guard + env imp is_tac + force_univ_constraints in + FStar_Compiler_Util.must uu___6 in let uu___6 = - FStar_Compiler_List.map - FStar_Pervasives_Native.fst - rest in - FStar_Compiler_List.op_At imps1 - uu___6 in - until_fixpoint ([], false) uu___5))) + let uu___7 = + FStar_Compiler_List.map + FStar_Pervasives_Native.fst + rest in + FStar_Compiler_List.op_At imps1 + uu___7 in + until_fixpoint ([], false, true) + uu___6))) | hd::tl -> let uu___1 = hd in (match uu___1 with @@ -15241,7 +15270,9 @@ let (resolve_implicits' : if FStar_Syntax_Syntax.uu___is_Allow_unresolved uvar_decoration_should_check - then until_fixpoint (out, true) tl + then + until_fixpoint + (out, true, defer_open_metas) tl else if (unresolved ctx_u) && @@ -15394,11 +15425,12 @@ let (resolve_implicits' : let typ = FStar_Syntax_Util.ctx_uvar_typ ctx_u in + let is_open = + (has_free_uvars typ) || + (gamma_has_free_uvars + ctx_u.FStar_Syntax_Syntax.ctx_uvar_gamma) in let uu___6 = - ((has_free_uvars typ) || - (gamma_has_free_uvars - ctx_u.FStar_Syntax_Syntax.ctx_uvar_gamma)) - && + (defer_open_metas && is_open) && (let uu___7 = FStar_Options.ext_getv "compat:open_metas" in @@ -15426,50 +15458,67 @@ let (resolve_implicits' : else ()); until_fixpoint (((hd, Implicit_unresolved) :: - out), changed) tl) + out), changed, + defer_open_metas) tl) else - (let solve_with t = - let extra = - let uu___8 = - teq_nosmt env1 t tm in - match uu___8 with - | FStar_Pervasives_Native.None - -> - FStar_Compiler_Effect.failwith - "resolve_implicits: unifying with an unresolved uvar failed?" - | FStar_Pervasives_Native.Some - g -> - g.FStar_TypeChecker_Common.implicits in - until_fixpoint (out, true) - (FStar_Compiler_List.op_At - extra tl) in - let uu___8 = cacheable tac in + (let uu___8 = + is_open && + (let uu___9 = + meta_tac_allowed_for_open_problem + tac in + Prims.op_Negation uu___9) in if uu___8 then - let uu___9 = - meta_arg_cache_lookup tac - env1 typ in - match uu___9 with - | FStar_Pervasives_Native.Some - res -> solve_with res - | FStar_Pervasives_Native.None - -> - let t = + until_fixpoint + (((hd, Implicit_unresolved) + :: out), changed, + defer_open_metas) tl + else + (let solve_with t = + let extra = + let uu___10 = + teq_nosmt env1 t tm in + match uu___10 with + | FStar_Pervasives_Native.None + -> + FStar_Compiler_Effect.failwith + "resolve_implicits: unifying with an unresolved uvar failed?" + | FStar_Pervasives_Native.Some + g -> + g.FStar_TypeChecker_Common.implicits in + until_fixpoint + (out, true, + defer_open_metas) + (FStar_Compiler_List.op_At + extra tl) in + let uu___10 = cacheable tac in + if uu___10 + then + let uu___11 = + meta_arg_cache_lookup tac + env1 typ in + match uu___11 with + | FStar_Pervasives_Native.Some + res -> solve_with res + | FStar_Pervasives_Native.None + -> + let t = + run_meta_arg_tac env1 + ctx_u in + (meta_arg_cache_result + tac env1 typ t; + solve_with t) + else + (let t = run_meta_arg_tac env1 ctx_u in - (meta_arg_cache_result tac - env1 typ t; - solve_with t) - else - (let t = - run_meta_arg_tac env1 ctx_u in - solve_with t))) + solve_with t)))) else if unresolved ctx_u then until_fixpoint (((hd, Implicit_unresolved) :: out), - changed) tl + changed, defer_open_metas) tl else if ((FStar_Syntax_Syntax.uu___is_Allow_untyped @@ -15478,7 +15527,9 @@ let (resolve_implicits' : (FStar_Syntax_Syntax.uu___is_Already_checked uvar_decoration_should_check)) || is_gen - then until_fixpoint (out, true) tl + then + until_fixpoint + (out, true, defer_open_metas) tl else (let env1 = { @@ -15659,7 +15710,9 @@ let (resolve_implicits' : "Impossible: check_implicit_solution_and_discharge_guard for tac must return Some []" else ()) else ()); - until_fixpoint (out, true) tl) + until_fixpoint + (out, true, defer_open_metas) + tl) else (let force_univ_constraints = false in @@ -15672,7 +15725,8 @@ let (resolve_implicits' : until_fixpoint (((hd1, Implicit_checking_defers_univ_constraint) - :: out), changed) tl + :: out), changed, + defer_open_metas) tl | FStar_Pervasives_Native.Some imps -> let uu___6 = @@ -15685,9 +15739,10 @@ let (resolve_implicits' : imps in FStar_Compiler_List.op_At uu___8 out in - (uu___7, true) in + (uu___7, true, + defer_open_metas) in until_fixpoint uu___6 tl)))))) in - until_fixpoint ([], false) implicits + until_fixpoint ([], false, true) implicits let (resolve_implicits : FStar_TypeChecker_Env.env -> FStar_TypeChecker_Common.guard_t -> FStar_TypeChecker_Common.guard_t) From 681304483b16e09776b8754420d8e65ea73a0cc8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 20 Apr 2024 22:35:16 -0700 Subject: [PATCH 054/239] Update expected output --- tests/error-messages/Bug1918.fst.expected | 4 ++-- tests/error-messages/Bug2021.fst.expected | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/error-messages/Bug1918.fst.expected b/tests/error-messages/Bug1918.fst.expected index b53d84b6f9e..75046b09eda 100644 --- a/tests/error-messages/Bug1918.fst.expected +++ b/tests/error-messages/Bug1918.fst.expected @@ -1,5 +1,5 @@ proof-state: State dump @ depth 0 (at the time of failure): -Location: FStar.Tactics.Typeclasses.fst(213,6-216,7) +Location: FStar.Tactics.Typeclasses.fst(289,6-292,7) Goal 1/1: |- _ : Bug1918.mon @@ -7,7 +7,7 @@ Goal 1/1: * Error 228 at Bug1918.fst(11,13-11,14): - Tactic failed - Could not solve constraint Bug1918.mon - - See also FStar.Tactics.Typeclasses.fst(213,6-216,7) + - See also FStar.Tactics.Typeclasses.fst(289,6-292,7) >>] Verified module: Bug1918 diff --git a/tests/error-messages/Bug2021.fst.expected b/tests/error-messages/Bug2021.fst.expected index 41aadd84b21..b100795ac1f 100644 --- a/tests/error-messages/Bug2021.fst.expected +++ b/tests/error-messages/Bug2021.fst.expected @@ -36,8 +36,8 @@ >>] >> Got issues: [ -* Error 66 at Bug2021.fst(37,13-37,14): - - Failed to resolve implicit argument ?11 +* Error 66 at Bug2021.fst(37,13-37,17): + - Failed to resolve implicit argument ?13 of type Prims.int introduced for Instantiating implicit argument in application - See also Bug2021.fst(36,11-36,12) From 49773ecf018d16a5c6f41a9d8661602db446e34d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 20 Apr 2024 18:03:15 -0700 Subject: [PATCH 055/239] Add a test --- tests/typeclasses/Fundeps.fst | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 tests/typeclasses/Fundeps.fst diff --git a/tests/typeclasses/Fundeps.fst b/tests/typeclasses/Fundeps.fst new file mode 100644 index 00000000000..64386b2867b --- /dev/null +++ b/tests/typeclasses/Fundeps.fst @@ -0,0 +1,17 @@ +module Fundeps + +[@@Tactics.Typeclasses.fundeps [0]] +class setlike (e:Type) (s:Type) = { + empty : s; + add : e -> s -> s; + remove : e -> s -> s; + contains : e -> s -> bool; + size : s -> int; +} + +assume val set (a:Type) : Type + +assume +instance val setlike_set (a:Type) : setlike a (set a) + +let test (s : set int) = size s From 0ac8a71bb1a728a29fc2ad99bbd42f5ccc547365 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Mon, 22 Apr 2024 12:56:21 -0700 Subject: [PATCH 056/239] remove duplicated guards --- .../generated/FStar_SMTEncoding_Encode.ml | 122 ++++++++---------- src/smtencoding/FStar.SMTEncoding.Encode.fst | 25 +--- 2 files changed, 55 insertions(+), 92 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index f18f126669d..551f6a7f3d6 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -4625,60 +4625,51 @@ let (encode_datacon : arg_decls) -> let guards_for_parameter orig_arg arg xv = - if - Prims.op_Negation - is_injective_on_tparams - then - FStar_SMTEncoding_Util.mkTrue - else - (let fv1 = - match - arg.FStar_SMTEncoding_Term.tm - with - | FStar_SMTEncoding_Term.FreeV - fv2 -> - fv2 - | uu___18 -> + let fv1 = + match arg.FStar_SMTEncoding_Term.tm + with + | FStar_SMTEncoding_Term.FreeV + fv2 -> fv2 + | uu___17 -> + let uu___18 + = let uu___19 = let uu___20 = - let uu___21 - = FStar_Syntax_Print.term_to_string orig_arg in FStar_Compiler_Util.format1 "Inductive type parameter %s must be a variable ; You may want to change it to an index." - uu___21 in + uu___20 in (FStar_Errors_Codes.Fatal_NonVariableInductiveTypeParameter, - uu___20) in - FStar_Errors.raise_error - uu___19 + uu___19) in + FStar_Errors.raise_error + uu___18 orig_arg.FStar_Syntax_Syntax.pos in - let guards1 = - FStar_Compiler_List.collect - (fun g -> - let uu___18 + let guards1 = + FStar_Compiler_List.collect + (fun g -> + let uu___17 = - let uu___19 + let uu___18 = FStar_SMTEncoding_Term.free_variables g in FStar_Compiler_List.contains fv1 - uu___19 in - if - uu___18 - then - let uu___19 + uu___18 in + if uu___17 + then + let uu___18 = FStar_SMTEncoding_Term.subst g fv1 xv in - [uu___19] - else []) - guards in - FStar_SMTEncoding_Util.mk_and_l - guards1) in + [uu___18] + else []) + guards in + FStar_SMTEncoding_Util.mk_and_l + guards1 in let uu___17 = let uu___18 = FStar_Compiler_List.zip @@ -5432,60 +5423,51 @@ let (encode_datacon : arg_decls) -> let guards_for_parameter orig_arg arg xv = - if - Prims.op_Negation - is_injective_on_tparams - then - FStar_SMTEncoding_Util.mkTrue - else - (let fv1 = - match - arg.FStar_SMTEncoding_Term.tm - with - | FStar_SMTEncoding_Term.FreeV - fv2 -> - fv2 - | uu___14 -> + let fv1 = + match arg.FStar_SMTEncoding_Term.tm + with + | FStar_SMTEncoding_Term.FreeV + fv2 -> fv2 + | uu___13 -> + let uu___14 + = let uu___15 = let uu___16 = - let uu___17 - = FStar_Syntax_Print.term_to_string orig_arg in FStar_Compiler_Util.format1 "Inductive type parameter %s must be a variable ; You may want to change it to an index." - uu___17 in + uu___16 in (FStar_Errors_Codes.Fatal_NonVariableInductiveTypeParameter, - uu___16) in - FStar_Errors.raise_error - uu___15 + uu___15) in + FStar_Errors.raise_error + uu___14 orig_arg.FStar_Syntax_Syntax.pos in - let guards1 = - FStar_Compiler_List.collect - (fun g -> - let uu___14 + let guards1 = + FStar_Compiler_List.collect + (fun g -> + let uu___13 = - let uu___15 + let uu___14 = FStar_SMTEncoding_Term.free_variables g in FStar_Compiler_List.contains fv1 - uu___15 in - if - uu___14 - then - let uu___15 + uu___14 in + if uu___13 + then + let uu___14 = FStar_SMTEncoding_Term.subst g fv1 xv in - [uu___15] - else []) - guards in - FStar_SMTEncoding_Util.mk_and_l - guards1) in + [uu___14] + else []) + guards in + FStar_SMTEncoding_Util.mk_and_l + guards1 in let uu___13 = let uu___14 = FStar_Compiler_List.zip diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index 3f2213ade20..1b14cfedd9b 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -1289,27 +1289,6 @@ let encode_datacon (is_injective_on_tparams:bool) (env:env_t) (se:sigelt) | Tm_fvar fv -> let encoded_head_fvb = lookup_free_var_name env' fv.fv_name in let encoded_args, arg_decls = encode_args args env' in - let guards_for_parameter (orig_arg:S.term)(arg:term) xv = - if not is_injective_on_tparams - then mkTrue - else ( - let fv = - match arg.tm with - | FreeV fv -> fv - | _ -> - Errors.raise_error (Errors.Fatal_NonVariableInductiveTypeParameter, - BU.format1 "Inductive type parameter %s must be a variable ; \ - You may want to change it to an index." - (FStar.Syntax.Print.term_to_string orig_arg)) orig_arg.pos - in - let guards = guards |> List.collect (fun g -> - if List.contains fv (Term.free_variables g) - then [Term.subst g fv xv] - else []) - in - mk_and_l guards - ) - in let _, arg_vars, elim_eqns_or_guards, _ = List.fold_left (fun (env, arg_vars, eqns_or_guards, i) (orig_arg, arg) -> @@ -1318,7 +1297,7 @@ let encode_datacon (is_injective_on_tparams:bool) (env:env_t) (se:sigelt) (* Also see https://github.com/FStarLang/FStar/issues/349 *) let eqns = if i < n_tps - then guards_for_parameter (fst orig_arg) arg xv::eqns_or_guards + then eqns_or_guards else mkEq(arg, xv)::eqns_or_guards in (env, xv::arg_vars, eqns, i + 1)) @@ -1328,6 +1307,8 @@ let encode_datacon (is_injective_on_tparams:bool) (env:env_t) (se:sigelt) let arg_vars = List.rev arg_vars in let arg_params, _ = List.splitAt n_tps arg_vars in let data_arg_params, _ = List.splitAt n_tps vars in + //Express the guards in terms of the parameters of the type constructor + //not the arguments of the data constructor let elim_eqns_and_guards = List.fold_left2 (fun elim_eqns_and_guards data_arg_param arg_param -> From ba8cb90722765a3d2b1b51e62ec6a64d3031b9ae Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Mon, 22 Apr 2024 12:57:56 -0700 Subject: [PATCH 057/239] revert disabling compat options --- .../generated/FStar_SMTEncoding_Encode.ml | 142 +++--------------- src/smtencoding/FStar.SMTEncoding.Encode.fst | 17 +-- 2 files changed, 25 insertions(+), 134 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index 551f6a7f3d6..0cb6a4a5751 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -4101,19 +4101,25 @@ let (encode_sig_inductive : "Impossible" else (); (let eqs = - if + let uu___13 = is_injective_on_params + || + (let uu___14 = + FStar_Options.ext_getv + "compat:injectivity" in + uu___14 <> "") in + if uu___13 then FStar_Compiler_List.map2 (fun v -> fun a -> - let uu___13 = - let uu___14 = + let uu___14 = + let uu___15 = FStar_SMTEncoding_Util.mkFreeV v in - (uu___14, a) in + (uu___15, a) in FStar_SMTEncoding_Util.mkEq - uu___13) vars + uu___14) vars indices1 else [] in let uu___13 = @@ -4469,13 +4475,19 @@ let (encode_datacon : env1 in (match uu___6 with | (vars, guards, env', binder_decls, names) -> + let is_injective_on_tparams1 = + is_injective_on_tparams || + (let uu___7 = + FStar_Options.ext_getv + "compat:injectivity" in + uu___7 <> "") in let fields = FStar_Compiler_List.mapi (fun n -> fun x -> let field_projectible = (n >= n_tps) || - is_injective_on_tparams in + is_injective_on_tparams1 in let uu___7 = FStar_SMTEncoding_Env.mk_term_projector_name d x in @@ -4507,7 +4519,7 @@ let (encode_datacon : uu___9; FStar_SMTEncoding_Term.constr_base = (Prims.op_Negation - is_injective_on_tparams) + is_injective_on_tparams1) } in FStar_SMTEncoding_Term.constructor_to_decl uu___7 uu___8 in @@ -4623,53 +4635,6 @@ let (encode_datacon : (match uu___16 with | (encoded_args, arg_decls) -> - let guards_for_parameter - orig_arg arg xv = - let fv1 = - match arg.FStar_SMTEncoding_Term.tm - with - | FStar_SMTEncoding_Term.FreeV - fv2 -> fv2 - | uu___17 -> - let uu___18 - = - let uu___19 - = - let uu___20 - = - FStar_Syntax_Print.term_to_string - orig_arg in - FStar_Compiler_Util.format1 - "Inductive type parameter %s must be a variable ; You may want to change it to an index." - uu___20 in - (FStar_Errors_Codes.Fatal_NonVariableInductiveTypeParameter, - uu___19) in - FStar_Errors.raise_error - uu___18 - orig_arg.FStar_Syntax_Syntax.pos in - let guards1 = - FStar_Compiler_List.collect - (fun g -> - let uu___17 - = - let uu___18 - = - FStar_SMTEncoding_Term.free_variables - g in - FStar_Compiler_List.contains - fv1 - uu___18 in - if uu___17 - then - let uu___18 - = - FStar_SMTEncoding_Term.subst - g fv1 xv in - [uu___18] - else []) - guards in - FStar_SMTEncoding_Util.mk_and_l - guards1 in let uu___17 = let uu___18 = FStar_Compiler_List.zip @@ -4711,14 +4676,6 @@ let (encode_datacon : if i < n_tps then - let uu___23 - = - guards_for_parameter - (FStar_Pervasives_Native.fst - orig_arg) - arg xv in - uu___23 - :: eqns_or_guards else (let uu___24 @@ -5421,53 +5378,6 @@ let (encode_datacon : (match uu___12 with | (encoded_args, arg_decls) -> - let guards_for_parameter - orig_arg arg xv = - let fv1 = - match arg.FStar_SMTEncoding_Term.tm - with - | FStar_SMTEncoding_Term.FreeV - fv2 -> fv2 - | uu___13 -> - let uu___14 - = - let uu___15 - = - let uu___16 - = - FStar_Syntax_Print.term_to_string - orig_arg in - FStar_Compiler_Util.format1 - "Inductive type parameter %s must be a variable ; You may want to change it to an index." - uu___16 in - (FStar_Errors_Codes.Fatal_NonVariableInductiveTypeParameter, - uu___15) in - FStar_Errors.raise_error - uu___14 - orig_arg.FStar_Syntax_Syntax.pos in - let guards1 = - FStar_Compiler_List.collect - (fun g -> - let uu___13 - = - let uu___14 - = - FStar_SMTEncoding_Term.free_variables - g in - FStar_Compiler_List.contains - fv1 - uu___14 in - if uu___13 - then - let uu___14 - = - FStar_SMTEncoding_Term.subst - g fv1 xv in - [uu___14] - else []) - guards in - FStar_SMTEncoding_Util.mk_and_l - guards1 in let uu___13 = let uu___14 = FStar_Compiler_List.zip @@ -5509,14 +5419,6 @@ let (encode_datacon : if i < n_tps then - let uu___19 - = - guards_for_parameter - (FStar_Pervasives_Native.fst - orig_arg) - arg xv in - uu___19 - :: eqns_or_guards else (let uu___20 @@ -7088,11 +6990,7 @@ and (encode_sigelt' : (fun se1 -> FStar_Syntax_Syntax.uu___is_Sig_inductive_typ se1.FStar_Syntax_Syntax.sigel) ses in - let is_injective_on_params = - match tycon with - | FStar_Pervasives_Native.None -> false - | FStar_Pervasives_Native.Some se1 -> - is_sig_inductive_injective_on_params env se1 in + let is_injective_on_params = false in let uu___2 = FStar_Compiler_List.fold_left (fun uu___3 -> diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index 1b14cfedd9b..0a02ec0de0e 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -1116,7 +1116,7 @@ let encode_sig_inductive (is_injective_on_params:bool) (env:env_t) (se:sigelt) then failwith "Impossible"; let eqs = if is_injective_on_params - // || Options.ext_getv "compat:injectivity" <> "" + || Options.ext_getv "compat:injectivity" <> "" then List.map2 (fun v a -> mkEq(mkFreeV v, a)) vars indices else [] // //only injectivity on indices @@ -1228,9 +1228,9 @@ let encode_datacon (is_injective_on_tparams:bool) (env:env_t) (se:sigelt) let fuel_var, fuel_tm = fresh_fvar env.current_module_name "f" Fuel_sort in let s_fuel_tm = mkApp("SFuel", [fuel_tm]) in let vars, guards, env', binder_decls, names = encode_binders (Some fuel_tm) formals env in - // let is_injective_on_tparams = - // is_injective_on_tparams || Options.ext_getv "compat:injectivity" <> "" - // in + let is_injective_on_tparams = + is_injective_on_tparams || Options.ext_getv "compat:injectivity" <> "" + in let fields = names |> List.mapi @@ -1758,14 +1758,7 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = | Sig_bundle {ses} -> let tycon = List.tryFind (fun se -> Sig_inductive_typ? se.sigel) ses in - let is_injective_on_params = - match tycon with - | None -> - //Exceptions appear as Sig_bundle without an inductive type - false - | Some se -> - is_sig_inductive_injective_on_params env se - in + let is_injective_on_params = false in let g, env = ses |> List.fold_left From f97222bc2a69a1bda3fe803c6567b4f4834b286c Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Mon, 22 Apr 2024 13:23:13 -0700 Subject: [PATCH 058/239] revert disabling injectivity globally --- ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml | 6 +++++- src/smtencoding/FStar.SMTEncoding.Encode.fst | 9 ++++++++- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index 0cb6a4a5751..2c874ea70ca 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -6990,7 +6990,11 @@ and (encode_sigelt' : (fun se1 -> FStar_Syntax_Syntax.uu___is_Sig_inductive_typ se1.FStar_Syntax_Syntax.sigel) ses in - let is_injective_on_params = false in + let is_injective_on_params = + match tycon with + | FStar_Pervasives_Native.None -> false + | FStar_Pervasives_Native.Some se1 -> + is_sig_inductive_injective_on_params env se1 in let uu___2 = FStar_Compiler_List.fold_left (fun uu___3 -> diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index 0a02ec0de0e..007a612881f 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -1758,7 +1758,14 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = | Sig_bundle {ses} -> let tycon = List.tryFind (fun se -> Sig_inductive_typ? se.sigel) ses in - let is_injective_on_params = false in + let is_injective_on_params = + match tycon with + | None -> + //Exceptions appear as Sig_bundle without an inductive type + false + | Some se -> + is_sig_inductive_injective_on_params env se + in let g, env = ses |> List.fold_left From c1170739f99cf821765b610cf9983bf98595f91d Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Mon, 22 Apr 2024 14:37:53 -0700 Subject: [PATCH 059/239] undo ulib changes --- ulib/FStar.ModifiesGen.fst | 30 ++++++++---------------------- ulib/FStar.WellFounded.Util.fst | 4 ++-- ulib/FStar.WellFounded.fst | 25 +++++-------------------- ulib/FStar.WellFoundedRelation.fst | 9 +-------- ulib/legacy/FStar.Constructive.fst | 13 +++++-------- 5 files changed, 21 insertions(+), 60 deletions(-) diff --git a/ulib/FStar.ModifiesGen.fst b/ulib/FStar.ModifiesGen.fst index 118c6a4b50c..29086459d87 100644 --- a/ulib/FStar.ModifiesGen.fst +++ b/ulib/FStar.ModifiesGen.fst @@ -17,7 +17,7 @@ module FStar.ModifiesGen #set-options "--split_queries no" #set-options "--using_facts_from '*,-FStar.Tactics,-FStar.Reflection,-FStar.List'" -#set-options "--z3rlimit_factor 2" + module HS = FStar.HyperStack module HST = FStar.HyperStack.ST @@ -217,11 +217,7 @@ let loc_equal_elim (#al: aloc_t) (#c: cls al) (s1 s2: loc c) : Lemma (ensures (s1 == s2)) [SMTPat (s1 `loc_equal` s2)] = fun_set_equal_elim (Loc?.non_live_addrs s1) (Loc?.non_live_addrs s2); - fun_set_equal_elim (Loc?.live_addrs s1) (Loc?.live_addrs s2); - let Loc regions1 region_liveness_tags1 _ _ aux1 = s1 in - let Loc regions2 region_liveness_tags2 _ _ aux2 = s2 in - assert (regions1 == regions2); - assert (region_liveness_tags1 == region_liveness_tags2) + fun_set_equal_elim (Loc?.live_addrs s1) (Loc?.live_addrs s2) let loc_union_idem #al #c s = @@ -618,11 +614,7 @@ let loc_disjoint_aloc_elim #al #c #r1 #a1 #r2 #a2 b1 b2 = #push-options "--z3rlimit 15" let loc_disjoint_addresses_intro #al #c preserve_liveness1 preserve_liveness2 r1 r2 n1 n2 = // FIXME: WHY WHY WHY this assert? - let Loc _ _ _ _ _ = (loc_addresses #_ #c preserve_liveness1 r1 n1) in - let Loc _ _ _ _ _ = (loc_addresses #_ #c preserve_liveness2 r2 n2) in - assert (loc_aux_disjoint - (Ghost.reveal (Loc?.aux (loc_addresses #_ #c preserve_liveness1 r1 n1))) - (Ghost.reveal (Loc?.aux (loc_addresses #_ #c preserve_liveness2 r2 n2)))) + assert (loc_aux_disjoint (Ghost.reveal (Loc?.aux (loc_addresses #_ #c preserve_liveness1 r1 n1))) (Ghost.reveal (Loc?.aux (loc_addresses #_ #c preserve_liveness2 r2 n2)))) #pop-options let loc_disjoint_addresses_elim #al #c preserve_liveness1 preserve_liveness2 r1 r2 n1 n2 = () @@ -951,14 +943,12 @@ let modifies_intro_strong #al #c l h h' regions mrefs lives unused_ins alocs = (Set.mem (HS.frameOf p) (regions_of_loc l) ==> ~ (GSet.mem (HS.as_addr p) (addrs_of_loc l (HS.frameOf p)))))) (ensures (HS.contains h' p /\ HS.sel h' p == HS.sel h p)) = - let Loc _ _ _ _ _ = (loc_mreference #_ #c p) in - let Loc _ _ _ _ _ = l in assert_norm (Loc?.region_liveness_tags (loc_mreference #_ #c p) == Ghost.hide Set.empty); assert (loc_disjoint_region_liveness_tags (loc_mreference p) l); // FIXME: WHY WHY WHY is this assert necessary? - assert (loc_aux_disjoint (Ghost.reveal (Loc?.aux (loc_mreference p))) (Ghost.reveal (Loc?.aux l))); + assert_spinoff (loc_aux_disjoint (Ghost.reveal (Loc?.aux (loc_mreference p))) (Ghost.reveal (Loc?.aux l))); // FIXME: Now this one is too :) - assert_spinoff (loc_disjoint_addrs (loc_mreference p) l); + assert (loc_disjoint_addrs (loc_mreference p) l); assert ((loc_disjoint (loc_mreference p) l)); mrefs t pre p in @@ -1313,7 +1303,6 @@ let modifies_loc_addresses_intro_weak modifies_preserves_alocs_intro (loc_union (loc_addresses true r s) l) h1 h2 () (fun r' a b -> if r = r' then f a b else () ) -#push-options "--z3rlimit_factor 4" let modifies_loc_addresses_intro #al #c r s l h1 h2 = loc_includes_loc_regions_restrict_to_regions l (Set.singleton r); loc_includes_loc_union_restrict_to_regions l (Set.singleton r); @@ -1471,8 +1460,6 @@ let disjoint_addrs_of_loc_loc_disjoint )) (ensures (loc_disjoint l1 l2)) = // FIXME: WHY WHY WHY do I need this assert? - let Loc _ _ _ _ _ = l1 in - let Loc _ _ _ _ _ = l2 in let l1' = Ghost.reveal (Loc?.aux l1) in let l2' = Ghost.reveal (Loc?.aux l2) in assert (forall (b1 b2: aloc c) . (GSet.mem b1 l1' /\ GSet.mem b2 l2') ==> aloc_disjoint b1 b2) @@ -1770,7 +1757,7 @@ let mem_union_aux_of_aux_left_intro : Lemma (GSet.mem x aux <==> GSet.mem (ALoc x.region x.addr (if None? x.loc then None else Some (make_cls_union_aloc b (Some?.v x.loc)))) (union_aux_of_aux_left c b aux)) [SMTPat (GSet.mem x aux)] -= let ALoc _ _ _ = x in () += () let mem_union_aux_of_aux_left_elim (#al: (bool -> HS.rid -> nat -> Tot Type)) @@ -2131,12 +2118,12 @@ let upgrade_aloc (#al: aloc_t u#a) (#c: cls al) (a: aloc c) : Tot (aloc (raise_c let downgrade_aloc_upgrade_aloc (#al: aloc_t u#a) (#c: cls al) (a: aloc c) : Lemma (downgrade_aloc (upgrade_aloc u#a u#b a) == a) [SMTPat (downgrade_aloc (upgrade_aloc u#a u#b a))] -= let ALoc _ _ _ = a in () += () let upgrade_aloc_downgrade_aloc (#al: aloc_t u#a) (#c: cls al) (a: aloc (raise_cls u#a u#b c)) : Lemma (upgrade_aloc (downgrade_aloc a) == a) [SMTPat (upgrade_aloc u#a u#b (downgrade_aloc a))] -= let ALoc _ _ _ = a in () += () let raise_loc_aux_pred (#al: aloc_t u#a) @@ -2179,7 +2166,6 @@ let raise_loc_includes #al #c l1 l2 = #pop-options let raise_loc_disjoint #al #c l1 l2 = - // let ALoc _ _ _ = al in let l1' = raise_loc l1 in let l2' = raise_loc l2 in assert (forall (x: aloc (raise_cls c)) . GSet.mem x (Ghost.reveal (Loc?.aux l1')) <==> GSet.mem (downgrade_aloc x) (Ghost.reveal (Loc?.aux l1))); diff --git a/ulib/FStar.WellFounded.Util.fst b/ulib/FStar.WellFounded.Util.fst index a4fc7cdf1e2..a738123731b 100644 --- a/ulib/FStar.WellFounded.Util.fst +++ b/ulib/FStar.WellFounded.Util.fst @@ -52,7 +52,7 @@ let lift_binrel_well_founded (#a:Type u#a) : Tot (acc (lift_binrel r) y) (decreases pf) = AccIntro (fun (z:top) (p:lift_binrel r z y) -> - aux z (match pf with | AccIntro access_smaller -> access_smaller (dsnd z) (lower_binrel z y p))) + aux z (pf.access_smaller (dsnd z) (lower_binrel z y p))) in let aux' (y:top{dfst y =!= a}) : acc (lift_binrel r) y @@ -83,7 +83,7 @@ let lift_binrel_squashed_well_founded (#a:Type u#a) (decreases pf) = AccIntro (fun (z:top) (p:lift_binrel_squashed r z y) -> let p = lower_binrel_squashed z y p in - aux z (match pf with AccIntro access_smaller -> access_smaller (dsnd z) (FStar.Squash.join_squash p))) + aux z (pf.access_smaller (dsnd z) (FStar.Squash.join_squash p))) in let aux' (y:top{dfst y =!= a}) : acc (lift_binrel_squashed r) y diff --git a/ulib/FStar.WellFounded.fst b/ulib/FStar.WellFounded.fst index 639ea3324dd..97ee6223a4b 100644 --- a/ulib/FStar.WellFounded.fst +++ b/ulib/FStar.WellFounded.fst @@ -50,13 +50,7 @@ let rec fix_F (#aa:Type) (#r:binrel aa) (#p:(aa -> Type)) (f: (x:aa -> (y:aa -> r y x -> p y) -> p x)) (x:aa) (a:acc r x) : Tot (p x) (decreases a) - = f x (fun y h -> - let v : acc r y = - match a with - | AccIntro access_smaller -> - access_smaller y h - in - fix_F f y v) + = f x (fun y h -> fix_F f y (a.access_smaller y h)) let fix (#aa:Type) (#r:binrel aa) (rwf:well_founded r) (p:aa -> Type) (f:(x:aa -> (y:aa -> r y x -> p y) -> p x)) @@ -107,12 +101,9 @@ let subrelation_squash_wf (#a:Type u#a) let rec acc_y (x:a) (acc_r:acc r x) (y:a) (p:sub_r y x) : Tot (acc sub_r y) (decreases acc_r) - = let v : acc _ y = - match acc_r with - | AccIntro access_smaller -> - access_smaller y (elim_squash (sub_w y x p)) - in - AccIntro (acc_y y v) + = AccIntro (acc_y y (acc_r.access_smaller + y + (elim_squash (sub_w y x p)))) in FStar.Squash.return_squash (FStar.Squash.return_squash (AccIntro (acc_y x (r_wf x)))) ) @@ -135,12 +126,6 @@ let inverse_image_wf (#a:Type u#a) (#b:Type u#b) (#r_b:binrel u#b u#r b) = let rec aux (x:a) (acc_r_b:acc r_b (f x)) : Tot (acc (inverse_image r_b f) x) (decreases acc_r_b) = - AccIntro (fun y p -> - let v = - match acc_r_b with - | AccIntro access_smaller -> - access_smaller (f y) p - in - aux y v) + AccIntro (fun y p -> aux y (acc_r_b.access_smaller (f y) p)) in fun x -> aux x (r_b_wf (f x)) diff --git a/ulib/FStar.WellFoundedRelation.fst b/ulib/FStar.WellFoundedRelation.fst index ea8f6217d86..3460dfb52f3 100644 --- a/ulib/FStar.WellFoundedRelation.fst +++ b/ulib/FStar.WellFoundedRelation.fst @@ -62,14 +62,7 @@ let rec acc_decreaser let smaller (y: a{(acc_relation r) y x}) : (acc_classical (acc_relation r) y) = ( eliminate exists (p: r y x). True returns f y << f x - with _. assert ( - let v = - match f x with - | WF.AccIntro access_smaller -> - access_smaller y p - in - v == f y - ); + with _. assert ((f x).access_smaller y p == f y); acc_decreaser r f y ) in AccClassicalIntro smaller diff --git a/ulib/legacy/FStar.Constructive.fst b/ulib/legacy/FStar.Constructive.fst index 55dc7bbd980..249b52e6ca8 100644 --- a/ulib/legacy/FStar.Constructive.fst +++ b/ulib/legacy/FStar.Constructive.fst @@ -14,7 +14,6 @@ limitations under the License. *) module FStar.Constructive - type cand p1 p2 = | Conj : h1:p1 -> h2:p2 -> cand p1 p2 @@ -40,22 +39,20 @@ type ceq_type (a:Type) : Type -> Type = | ReflType : ceq_type a a val eq_ind : #a:Type -> x:a -> p:(a -> Type) -> f:p x -> y:a -> e:ceq x y -> Tot (p y) -let eq_ind #a x p f y e = let Refl = e in f +let eq_ind #a x p f y _ = f val ceq_eq : #a:Type{hasEq a} -> #x:a -> #y:a -> h:(ceq x y) -> Lemma (x = y) -let ceq_eq #a #x #y h = let Refl = h in () +let ceq_eq #a #x #y h = () val ceq_congruence : #a:Type -> #b:Type -> #x:a -> #y:a -> ceq x y -> f:(a -> GTot b) -> GTot (ceq (f x) (f y)) -let ceq_congruence #a #b #x #y h f = - let Refl = h in - Refl #_ #(f x) //refuse to infer terms with non-Tot effect +let ceq_congruence #a #b #x #y h f = Refl #_ #(f x) //refuse to infer terms with non-Tot effect val ceq_symm : #a:Type -> #x:a -> #y:a -> ceq x y -> Tot (ceq y x) -let ceq_symm #a #x #y h = let Refl = h in Refl +let ceq_symm #a #x #y h = Refl val ceq_trans : #a:Type -> #x:a -> #y:a -> #z:a -> ceq x y -> ceq y z -> Tot (ceq x z) -let ceq_trans #a #x #y #z hxy hyz = let Refl = hxy in let Refl = hyz in Refl +let ceq_trans #a #x #y #z hxy hyz = Refl type ctrue = | I : ctrue From 2a31bd045e3816f96c83e43b79a7f532e3a457dd Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Mon, 22 Apr 2024 15:10:37 -0700 Subject: [PATCH 060/239] reverting Bug3186; cleaning up BugBoxInjectivity --- tests/bug-reports/Bug3186.fst | 6 +-- tests/bug-reports/BugBoxInjectivity.fst | 54 +++++++++++++++++-------- 2 files changed, 39 insertions(+), 21 deletions(-) diff --git a/tests/bug-reports/Bug3186.fst b/tests/bug-reports/Bug3186.fst index 34b0d9ca191..4ce06ae1a4d 100644 --- a/tests/bug-reports/Bug3186.fst +++ b/tests/bug-reports/Bug3186.fst @@ -3,11 +3,7 @@ module Bug3186 let base (x:int) (_: unit {equals x 0}) = assert (x == 0) -let base2 (x:int) (hyp: equals x 0) = - let Refl = hyp in - assert (x == 0) - -let base2' (x:int) (hyp: equals x 0) = +let base2 (x:int) (_: equals x 0) = assert (x == 0) [@@expect_failure [19]] diff --git a/tests/bug-reports/BugBoxInjectivity.fst b/tests/bug-reports/BugBoxInjectivity.fst index db7f646c1fe..506ab6f0633 100644 --- a/tests/bug-reports/BugBoxInjectivity.fst +++ b/tests/bug-reports/BugBoxInjectivity.fst @@ -1,26 +1,32 @@ module BugBoxInjectivity -noeq -type ceq (#a:Type) x : a -> Type = - | Refl : ceq #a x x +//The original bug; using an indirection to subvert the injectivity check +let mytype1 = Type u#1 -let test a (x y:a) (h:ceq #a x y) : Lemma (x == y) = () - -[@expect_failure] -let bad (h0:ceq true true) (h1:ceq false false) : Lemma (true == false) = - let Refl = h0 in - let Refl = h1 in - () +type my_t (a:mytype1) : Type u#0 = + | My : my_t a -open FStar.Functions -module CC = FStar.Cardinality.Universes +let inj_my_t (#a:Type u#1) (x:my_t a) +: Lemma (x == My #a) += () + +[@@expect_failure] +let my_t_injective : squash (is_inj my_t) = + introduce forall f0 f1. + my_t f0 == my_t f1 ==> f0 == f1 + with introduce _ ==> _ + with _ . ( + inj_my_t #f0 My; + inj_my_t #f1 (coerce_eq () (My #f0)) + ) +//Same thing without the indirection type t (a:Type u#1) : Type u#0 = | Mk : t a let inj_t (#a:Type u#1) (x:t a) : Lemma (x == Mk #a) -= let Mk #_ = x in () += () [@@expect_failure] let t_injective : squash (is_inj t) = @@ -32,7 +38,9 @@ let t_injective : squash (is_inj t) = inj_t #f1 (coerce_eq () (Mk #f0)) ) - +open FStar.Functions +module CC = FStar.Cardinality.Universes +//Disabling the injectivity check on parameters is inconsistent #push-options "--ext 'compat:injectivity'" noeq type test2 (a:Type u#2) : Type u#1 = @@ -46,7 +54,6 @@ let test2_injective (f0 f1:Type u#2) = let x : test2 f0 = test2_inhabited f0 in let Mk2 #_ = x in () -open FStar.Functions let itest2_injective' : squash (is_inj test2) = introduce forall f0 f1. test2 f0 == test2 f1 ==> f0 == f1 @@ -55,4 +62,19 @@ let itest2_injective' : squash (is_inj test2) = test2_injective f0 f1 ) let fals () : squash False = - CC.no_inj_universes_suc test2 \ No newline at end of file + CC.no_inj_universes_suc test2 + + +//Another test case to make sure that indexed types can be inverted properly +noeq +type ceq (#a:Type) x : a -> Type = + | Refl : ceq #a x x + +let test a (x y:a) (h:ceq #a x y) : Lemma (x == y) = () + +//But without collapsing +[@expect_failure] +let bad (h0:ceq true true) (h1:ceq false false) : Lemma (true == false) = + let Refl = h0 in + let Refl = h1 in + () From 07b70f77023f5e92806e25d719215b7ae80d8866 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Mon, 22 Apr 2024 15:17:08 -0700 Subject: [PATCH 061/239] update a comment --- src/smtencoding/FStar.SMTEncoding.Encode.fst | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index 007a612881f..4a0a9a7d5f4 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -1119,12 +1119,6 @@ let encode_sig_inductive (is_injective_on_params:bool) (env:env_t) (se:sigelt) || Options.ext_getv "compat:injectivity" <> "" then List.map2 (fun v a -> mkEq(mkFreeV v, a)) vars indices else [] - // //only injectivity on indices - // let num_params = List.length tps in - // let _var_params, var_indices = List.splitAt num_params vars in - // let _i_params, indices = List.splitAt num_params indices in - // List.map2 (fun v a -> mkEq(mkFreeV v, a)) var_indices indices - // ) in mkOr(out, mkAnd(mk_data_tester env l xx, eqs |> mk_and_l)), decls@decls') (mkFalse, []) @@ -1801,7 +1795,7 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = g in //2. decls are all the function symbol declarations - // elts: not sure what this represents + // elts: all elements that have a key and which contain function declarations (not sure why this class is important to pull out) // rest: all the non-declarations, excepting the inversion axiom which is already identified above let decls, elts, rest = List.fold_left From 89b83ab63974f7abcf4c9952c125bc0e3889d80c Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Mon, 22 Apr 2024 16:33:15 -0700 Subject: [PATCH 062/239] Don't generate spurious declarations that rely on a projector of a type param when it doesn't exist --- .../generated/FStar_SMTEncoding_Encode.ml | 193 +++++++++--------- .../generated/FStar_SMTEncoding_EncodeTerm.ml | 15 +- src/smtencoding/FStar.SMTEncoding.Encode.fst | 34 +-- tests/bug-reports/BugTypeParamProjector.fst | 10 + tests/bug-reports/Makefile | 2 +- 5 files changed, 140 insertions(+), 114 deletions(-) create mode 100644 tests/bug-reports/BugTypeParamProjector.fst diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index 2c874ea70ca..055e9d7c871 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -4043,104 +4043,107 @@ let (encode_sig_inductive : fun l -> match uu___7 with | (out, decls) -> + let is_l = + FStar_SMTEncoding_Env.mk_data_tester env1 + l xx in let uu___8 = - FStar_TypeChecker_Env.lookup_datacon - env1.FStar_SMTEncoding_Env.tcenv l in - (match uu___8 with - | (uu___9, data_t) -> - let uu___10 = - FStar_Syntax_Util.arrow_formals - data_t in - (match uu___10 with - | (args, res) -> - let indices = - let uu___11 = - FStar_Syntax_Util.head_and_args_full - res in - FStar_Pervasives_Native.snd - uu___11 in - let env2 = - FStar_Compiler_List.fold_left - (fun env3 -> - fun uu___11 -> - match uu___11 with - | { - FStar_Syntax_Syntax.binder_bv - = x; - FStar_Syntax_Syntax.binder_qual - = uu___12; - FStar_Syntax_Syntax.binder_positivity - = uu___13; - FStar_Syntax_Syntax.binder_attrs - = uu___14;_} - -> - let uu___15 = - let uu___16 = - let uu___17 = - FStar_SMTEncoding_Env.mk_term_projector_name - l x in - (uu___17, [xx]) in - FStar_SMTEncoding_Util.mkApp - uu___16 in - FStar_SMTEncoding_Env.push_term_var - env3 x uu___15) - env1 args in - let uu___11 = - FStar_SMTEncoding_EncodeTerm.encode_args - indices env2 in - (match uu___11 with - | (indices1, decls') -> - (if - (FStar_Compiler_List.length - indices1) - <> - (FStar_Compiler_List.length - vars) - then - FStar_Compiler_Effect.failwith - "Impossible" - else (); - (let eqs = - let uu___13 = - is_injective_on_params - || - (let uu___14 = - FStar_Options.ext_getv - "compat:injectivity" in - uu___14 <> "") in - if uu___13 + let uu___9 = + is_injective_on_params || + (let uu___10 = + FStar_Options.ext_getv + "compat:injectivity" in + uu___10 <> "") in + if uu___9 + then + let uu___10 = + FStar_TypeChecker_Env.lookup_datacon + env1.FStar_SMTEncoding_Env.tcenv l in + match uu___10 with + | (uu___11, data_t) -> + let uu___12 = + FStar_Syntax_Util.arrow_formals + data_t in + (match uu___12 with + | (args, res) -> + let indices = + let uu___13 = + FStar_Syntax_Util.head_and_args_full + res in + FStar_Pervasives_Native.snd + uu___13 in + let env2 = + FStar_Compiler_List.fold_left + (fun env3 -> + fun uu___13 -> + match uu___13 with + | { + FStar_Syntax_Syntax.binder_bv + = x; + FStar_Syntax_Syntax.binder_qual + = uu___14; + FStar_Syntax_Syntax.binder_positivity + = uu___15; + FStar_Syntax_Syntax.binder_attrs + = uu___16;_} + -> + let uu___17 = + let uu___18 = + let uu___19 = + FStar_SMTEncoding_Env.mk_term_projector_name + l x in + (uu___19, + [xx]) in + FStar_SMTEncoding_Util.mkApp + uu___18 in + FStar_SMTEncoding_Env.push_term_var + env3 x uu___17) + env1 args in + let uu___13 = + FStar_SMTEncoding_EncodeTerm.encode_args + indices env2 in + (match uu___13 with + | (indices1, decls') -> + (if + (FStar_Compiler_List.length + indices1) + <> + (FStar_Compiler_List.length + vars) then - FStar_Compiler_List.map2 - (fun v -> - fun a -> - let uu___14 = - let uu___15 = - FStar_SMTEncoding_Util.mkFreeV + FStar_Compiler_Effect.failwith + "Impossible" + else (); + (let eqs = + FStar_Compiler_List.map2 + (fun v -> + fun a -> + let uu___15 = + let uu___16 + = + FStar_SMTEncoding_Util.mkFreeV v in - (uu___15, a) in - FStar_SMTEncoding_Util.mkEq - uu___14) vars - indices1 - else [] in - let uu___13 = - let uu___14 = - let uu___15 = - let uu___16 = - let uu___17 = - FStar_SMTEncoding_Env.mk_data_tester - env2 l xx in - let uu___18 = - FStar_SMTEncoding_Util.mk_and_l - eqs in - (uu___17, uu___18) in - FStar_SMTEncoding_Util.mkAnd - uu___16 in - (out, uu___15) in - FStar_SMTEncoding_Util.mkOr - uu___14 in - (uu___13, - (FStar_Compiler_List.op_At - decls decls')))))))) + (uu___16, a) in + FStar_SMTEncoding_Util.mkEq + uu___15) + vars indices1 in + let uu___15 = + let uu___16 = + let uu___17 = + FStar_SMTEncoding_Util.mk_and_l + eqs in + (is_l, uu___17) in + FStar_SMTEncoding_Util.mkAnd + uu___16 in + (uu___15, decls'))))) + else (is_l, []) in + (match uu___8 with + | (inversion_case, decls') -> + let uu___9 = + FStar_SMTEncoding_Util.mkOr + (out, inversion_case) in + (uu___9, + (FStar_Compiler_List.op_At decls + decls')))) (FStar_SMTEncoding_Util.mkFalse, []) datas in (match uu___6 with | (data_ax, decls) -> diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml index ec50ccf9f2f..850fdc2eb53 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml @@ -2939,9 +2939,18 @@ and (encode_term : FStar_SMTEncoding_Term.mkForall t0.FStar_Syntax_Syntax.pos uu___13 in - (uu___12, - (FStar_Pervasives_Native.Some - a_name), a_name) in + let uu___13 = + let uu___14 = + let uu___15 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + t0 in + FStar_Compiler_Util.format2 + "%s\n;; %s\n" a_name + uu___15 in + FStar_Pervasives_Native.Some + uu___14 in + (uu___12, uu___13, a_name) in FStar_SMTEncoding_Util.mkAssume uu___11 in let f_decls = diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index 4a0a9a7d5f4..b3ae7d55d87 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -1105,22 +1105,26 @@ let encode_sig_inductive (is_injective_on_params:bool) (env:env_t) (se:sigelt) datas |> List.fold_left (fun (out, decls) l -> - let _, data_t = Env.lookup_datacon env.tcenv l in - let args, res = U.arrow_formals data_t in - let indices = res |> U.head_and_args_full |> snd in - let env = args |> List.fold_left - (fun env ({binder_bv=x}) -> push_term_var env x (mkApp(mk_term_projector_name l x, [xx]))) - env in - let indices, decls' = encode_args indices env in - if List.length indices <> List.length vars - then failwith "Impossible"; - let eqs = - if is_injective_on_params - || Options.ext_getv "compat:injectivity" <> "" - then List.map2 (fun v a -> mkEq(mkFreeV v, a)) vars indices - else [] + let is_l = mk_data_tester env l xx in + let inversion_case, decls' = + if is_injective_on_params + || Options.ext_getv "compat:injectivity" <> "" + then ( + let _, data_t = Env.lookup_datacon env.tcenv l in + let args, res = U.arrow_formals data_t in + let indices = res |> U.head_and_args_full |> snd in + let env = args |> List.fold_left + (fun env ({binder_bv=x}) -> push_term_var env x (mkApp(mk_term_projector_name l x, [xx]))) + env in + let indices, decls' = encode_args indices env in + if List.length indices <> List.length vars + then failwith "Impossible"; + let eqs = List.map2 (fun v a -> mkEq(mkFreeV v, a)) vars indices in + mkAnd(is_l, mk_and_l eqs), decls' + ) + else is_l, [] in - mkOr(out, mkAnd(mk_data_tester env l xx, eqs |> mk_and_l)), decls@decls') + mkOr(out, inversion_case), decls@decls') (mkFalse, []) in let ffsym, ff = fresh_fvar env.current_module_name "f" Fuel_sort in diff --git a/tests/bug-reports/BugTypeParamProjector.fst b/tests/bug-reports/BugTypeParamProjector.fst new file mode 100644 index 00000000000..67671dc1b55 --- /dev/null +++ b/tests/bug-reports/BugTypeParamProjector.fst @@ -0,0 +1,10 @@ +module BugTypeParamProjector + +type st : Type u#1 = + | MkST: f:int -> st + +noeq +type f (s:st) : (unit -> int) -> Type u#0 = + | MkF : f s (fun _ -> MkST?.f s) + +let test #s #g (x:f s g) = assert (MkF? x) diff --git a/tests/bug-reports/Makefile b/tests/bug-reports/Makefile index 4a9d5850c39..ce2246e09d5 100644 --- a/tests/bug-reports/Makefile +++ b/tests/bug-reports/Makefile @@ -78,7 +78,7 @@ SHOULD_VERIFY_CLOSED=\ Bug3120a.fst Bug3120b.fst Bug3186.fst Bug3185.fst Bug3210.fst \ Bug3213.fst Bug3213b.fst Bug3207.fst Bug3207b.fst Bug3207c.fst \ Bug2155.fst Bug3224a.fst Bug3224b.fst Bug3236.fst Bug3252.fst \ - BugBoxInjectivity.fst + BugBoxInjectivity.fst BugTypeParamProjector.fst SHOULD_VERIFY_INTERFACE_CLOSED=Bug771.fsti Bug771b.fsti SHOULD_VERIFY_AND_WARN_CLOSED=Bug016.fst From 34089dd1d9ad2d6e6d9e9ff87248a2e234a8f295 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Mon, 22 Apr 2024 17:22:57 -0700 Subject: [PATCH 063/239] snap --- .../generated/FStar_SMTEncoding_EncodeTerm.ml | 15 +++------------ 1 file changed, 3 insertions(+), 12 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml index 850fdc2eb53..ec50ccf9f2f 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml @@ -2939,18 +2939,9 @@ and (encode_term : FStar_SMTEncoding_Term.mkForall t0.FStar_Syntax_Syntax.pos uu___13 in - let uu___13 = - let uu___14 = - let uu___15 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term - t0 in - FStar_Compiler_Util.format2 - "%s\n;; %s\n" a_name - uu___15 in - FStar_Pervasives_Native.Some - uu___14 in - (uu___12, uu___13, a_name) in + (uu___12, + (FStar_Pervasives_Native.Some + a_name), a_name) in FStar_SMTEncoding_Util.mkAssume uu___11 in let f_decls = From c35cd2810c3c3c0fbdc7caa485610e1a47e594e2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 22 Apr 2024 19:46:28 -0700 Subject: [PATCH 064/239] Rel: restore compat option behavior --- src/typechecker/FStar.TypeChecker.Rel.fst | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.Rel.fst b/src/typechecker/FStar.TypeChecker.Rel.fst index ba34924307b..efe14da6f70 100644 --- a/src/typechecker/FStar.TypeChecker.Rel.fst +++ b/src/typechecker/FStar.TypeChecker.Rel.fst @@ -5550,15 +5550,14 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) let env = { env with gamma = ctx_u.ctx_uvar_gamma } in let typ = U.ctx_uvar_typ ctx_u in let is_open = has_free_uvars typ || gamma_has_free_uvars ctx_u.ctx_uvar_gamma in - if defer_open_metas && is_open - && Options.ext_getv "compat:open_metas" = "" then // i.e. compat option unset - ( + if defer_open_metas && is_open then ( (* If the result type or env for this meta arg has a free uvar, delay it. Some other meta arg being solved may instantiate the uvar. See #3130. *) if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "Imps" then BU.print1 "Deferring implicit due to open ctx/typ %s\n" (show ctx_u); until_fixpoint ((hd, Implicit_unresolved)::out, changed, defer_open_metas) tl - ) else if is_open && not (meta_tac_allowed_for_open_problem tac) then ( + ) else if is_open && not (meta_tac_allowed_for_open_problem tac) + && Options.ext_getv "compat:open_metas" = "" then ( // i.e. compat option unset (* If the tactic is not explicitly whitelisted to run with open problems, then defer. *) until_fixpoint ((hd, Implicit_unresolved)::out, changed, defer_open_metas) tl From fd58a6f2f585acec0a64f2b6ebb3ac6c23e25357 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 22 Apr 2024 19:46:50 -0700 Subject: [PATCH 065/239] snap --- .../generated/FStar_TypeChecker_Rel.ml | 47 +++++++++---------- 1 file changed, 23 insertions(+), 24 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml index cb1495cd91f..d9a29550d16 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml @@ -15429,15 +15429,9 @@ let (resolve_implicits' : (has_free_uvars typ) || (gamma_has_free_uvars ctx_u.FStar_Syntax_Syntax.ctx_uvar_gamma) in - let uu___6 = - (defer_open_metas && is_open) && - (let uu___7 = - FStar_Options.ext_getv - "compat:open_metas" in - uu___7 = "") in - if uu___6 + if defer_open_metas && is_open then - ((let uu___8 = + ((let uu___7 = (FStar_TypeChecker_Env.debug env1 (FStar_Options.Other "Rel")) @@ -15446,28 +15440,33 @@ let (resolve_implicits' : env1 (FStar_Options.Other "Imps")) in - if uu___8 + if uu___7 then - let uu___9 = + let uu___8 = FStar_Class_Show.show FStar_Syntax_Print.showable_ctxu ctx_u in FStar_Compiler_Util.print1 "Deferring implicit due to open ctx/typ %s\n" - uu___9 + uu___8 else ()); until_fixpoint (((hd, Implicit_unresolved) :: out), changed, defer_open_metas) tl) else - (let uu___8 = - is_open && - (let uu___9 = - meta_tac_allowed_for_open_problem - tac in - Prims.op_Negation uu___9) in - if uu___8 + (let uu___7 = + (is_open && + (let uu___8 = + meta_tac_allowed_for_open_problem + tac in + Prims.op_Negation uu___8)) + && + (let uu___8 = + FStar_Options.ext_getv + "compat:open_metas" in + uu___8 = "") in + if uu___7 then until_fixpoint (((hd, Implicit_unresolved) @@ -15476,9 +15475,9 @@ let (resolve_implicits' : else (let solve_with t = let extra = - let uu___10 = + let uu___9 = teq_nosmt env1 t tm in - match uu___10 with + match uu___9 with | FStar_Pervasives_Native.None -> FStar_Compiler_Effect.failwith @@ -15491,13 +15490,13 @@ let (resolve_implicits' : defer_open_metas) (FStar_Compiler_List.op_At extra tl) in - let uu___10 = cacheable tac in - if uu___10 + let uu___9 = cacheable tac in + if uu___9 then - let uu___11 = + let uu___10 = meta_arg_cache_lookup tac env1 typ in - match uu___11 with + match uu___10 with | FStar_Pervasives_Native.Some res -> solve_with res | FStar_Pervasives_Native.None From 7c9a3de3fbbe3948c0318c5a20277237a5f37877 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 19 Apr 2024 21:08:50 -0700 Subject: [PATCH 066/239] A comment --- src/typechecker/FStar.TypeChecker.Common.fsti | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/typechecker/FStar.TypeChecker.Common.fsti b/src/typechecker/FStar.TypeChecker.Common.fsti index b95180e7aa1..8e91e651af0 100644 --- a/src/typechecker/FStar.TypeChecker.Common.fsti +++ b/src/typechecker/FStar.TypeChecker.Common.fsti @@ -192,7 +192,7 @@ val mk_lcomp: val lcomp_comp: lcomp -> (comp * guard_t) val apply_lcomp : (comp -> comp) -> (guard_t -> guard_t) -> lcomp -> lcomp -val lcomp_to_string : lcomp -> string +val lcomp_to_string : lcomp -> string (* CAUTION! can have side effects of forcing the lcomp *) val lcomp_set_flags : lcomp -> list S.cflag -> lcomp val is_total_lcomp : lcomp -> bool val is_tot_or_gtot_lcomp : lcomp -> bool From 98fd7beb9e1eb3e8f6d100c3118fab704e89dc5d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 19 Apr 2024 21:09:21 -0700 Subject: [PATCH 067/239] Tc: use more typeclasses --- src/typechecker/FStar.TypeChecker.TcTerm.fst | 15 ++++++--------- src/typechecker/FStar.TypeChecker.Util.fst | 11 +++-------- 2 files changed, 9 insertions(+), 17 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.TcTerm.fst b/src/typechecker/FStar.TypeChecker.TcTerm.fst index 245739fb447..5e8885771ae 100644 --- a/src/typechecker/FStar.TypeChecker.TcTerm.fst +++ b/src/typechecker/FStar.TypeChecker.TcTerm.fst @@ -2441,7 +2441,8 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term let n_args = List.length args in let r = Env.get_range env in let thead = U.comp_result chead in - if debug env Options.High then BU.print2 "(%s) Type of head is %s\n" (Range.string_of_range head.pos) (Print.term_to_string thead); + if debug env Options.High then + BU.print3 "(%s) Type of head is %s\nArgs = %s\n" (show head.pos) (show thead) (show args); (* given |- head : chead | ghead where head is a computation returning a function of type (bs0@bs -> cres) @@ -2462,7 +2463,7 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term let monadic_application (head, chead, ghead, cres) (* the head of the application, its lcomp chead, and guard ghead, returning a bs -> cres *) subst (* substituting actuals for formals seen so far, when actual is pure *) - (arg_comps_rev:list (arg * option bv * lcomp)) (* type-checked actual arguments, so far; in reverse order *) + (arg_comps_rev:list (arg * option bv * lcomp)) (* type-checked actual arguments, so far; in reverse order *) arg_rets_rev (* The results of each argument at the logic level, in reverse order *) guard (* conjoined guard formula for all the actuals *) fvs (* unsubstituted formals, to check that they do not occur free elsewhere in the type of f *) @@ -2672,7 +2673,7 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term if warn_effectful_args then Errors.log_issue e.pos (Errors.Warning_EffectfulArgumentToErasedFunction, (format3 "Effectful argument %s (%s) to erased function %s, consider let binding it" - (Print.term_to_string e) (string_of_lid c.eff_name) (Print.term_to_string head))); + (show e) (show c.eff_name) (show head))); if Env.debug env Options.Extreme then BU.print_string "... lifting!\n"; let x = S.new_bv None c.res_typ in @@ -2707,7 +2708,7 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term // let comp, g = comp, guard in let comp, g = TcUtil.strengthen_precondition None env app comp guard in if Env.debug env Options.Extreme then BU.print2 "(d) Monadic app: type of app\n\t(%s)\n\t: %s\n" - (Print.term_to_string app) + (show app) (TcComm.lcomp_to_string comp); app, comp, g in @@ -2816,11 +2817,7 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term let x = {x with sort=targ} in if debug env Options.Extreme then BU.print5 "\tFormal is %s : %s\tType of arg %s (after subst %s) = %s\n" - (Print.bv_to_string x) - (Print.term_to_string x.sort) - (Print.term_to_string e) - (Print.subst_to_string subst) - (Print.term_to_string targ); + (show x) (show x.sort) (show e) (show subst) (show targ); let targ, g_ex = check_no_escape (Some head) env fvs targ in let env = Env.set_expected_typ_maybe_eq env targ (is_eq bqual) in if debug env Options.High diff --git a/src/typechecker/FStar.TypeChecker.Util.fst b/src/typechecker/FStar.TypeChecker.Util.fst index cd28a4d35be..d9df1e66f41 100644 --- a/src/typechecker/FStar.TypeChecker.Util.fst +++ b/src/typechecker/FStar.TypeChecker.Util.fst @@ -2828,10 +2828,7 @@ let maybe_instantiate (env:Env.env) e t = else begin if Env.debug env Options.High then BU.print3 "maybe_instantiate: starting check for (%s) of type (%s), expected type is %s\n" - (Print.term_to_string e) (Print.term_to_string t) - (match Env.expected_typ env with - | None -> "None" - | Some (t, _) -> Print.term_to_string t); + (show e) (show t) (show (Env.expected_typ env)); (* Similar to U.arrow_formals, but makes sure to unfold * recursively to catch all the binders across type * definitions. TODO: Move to library? Revise other uses @@ -2885,8 +2882,7 @@ let maybe_instantiate (env:Env.env) e t = let t = SS.subst subst x.sort in let v, _, g = new_implicit_var "Instantiation of implicit argument" e.pos env t in if Env.debug env Options.High then - BU.print1 "maybe_instantiate: Instantiating implicit with %s\n" - (Print.term_to_string v); + BU.print1 "maybe_instantiate: Instantiating implicit with %s\n" (show v); let subst = NT(x, v)::subst in let aq = U.aqual_of_binder (List.hd bs) in let args, bs, subst, g' = aux subst (decr_inst inst_n) rest in @@ -2915,8 +2911,7 @@ let maybe_instantiate (env:Env.env) e t = e.pos env t Strict (Some meta_t) in if Env.debug env Options.High then - BU.print1 "maybe_instantiate: Instantiating meta argument with %s\n" - (Print.term_to_string v); + BU.print1 "maybe_instantiate: Instantiating meta argument with %s\n" (show v); let subst = NT(x, v)::subst in let aq = U.aqual_of_binder (List.hd bs) in let args, bs, subst, g' = aux subst (decr_inst inst_n) rest in From 8747b9222d680a8ce640456e1db12591961cecb6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 21 Apr 2024 12:25:31 -0700 Subject: [PATCH 068/239] class: introducing a 'setlike' class --- src/class/FStar.Class.Setlike.fst | 6 ++++++ src/class/FStar.Class.Setlike.fsti | 27 +++++++++++++++++++++++++++ 2 files changed, 33 insertions(+) create mode 100644 src/class/FStar.Class.Setlike.fst create mode 100644 src/class/FStar.Class.Setlike.fsti diff --git a/src/class/FStar.Class.Setlike.fst b/src/class/FStar.Class.Setlike.fst new file mode 100644 index 00000000000..ab9963f178c --- /dev/null +++ b/src/class/FStar.Class.Setlike.fst @@ -0,0 +1,6 @@ +module FStar.Class.Setlike + +open FStar.Compiler.Effect +open FStar.Class.Ord + +let symdiff s1 s2 = diff s1 s2 diff --git a/src/class/FStar.Class.Setlike.fsti b/src/class/FStar.Class.Setlike.fsti new file mode 100644 index 00000000000..28536a5e06e --- /dev/null +++ b/src/class/FStar.Class.Setlike.fsti @@ -0,0 +1,27 @@ +module FStar.Class.Setlike + +open FStar.Compiler.Effect +open FStar.Class.Ord + +[@@Tactics.Typeclasses.fundeps [0]] +class setlike (e:Type) (s:Type) = { + empty : unit -> s; + singleton : e -> s; + is_empty : s -> bool; + from_list : list e -> s; + elems : s -> list e; + add : e -> s -> s; + addn : list e -> s -> s; + remove : e -> s -> s; + mem : e -> s -> bool; + equal : s -> s -> bool; + subset : s -> s -> bool; + union : s -> s -> s; + inter : s -> s -> s; + diff : s -> s -> s; + collect : (e -> s) -> list e -> s; + for_all : (e -> bool) -> s -> bool; + for_any : (e -> bool) -> s -> bool; +} + +val symdiff (#e #s : Type) {| setlike e s |} : s -> s -> s From a2dca41ab94b1a39e303586299fb6d20e3c29a10 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 21 Apr 2024 12:25:51 -0700 Subject: [PATCH 069/239] src: Rename FStar.Compiler.Set to FStar.Compiler.FlatSet, use class too This 'set' is somewhat inefficient and problematic. Make the name reflect that, and use the class so replacing some instances of FlatSet for better implementations is seamless. --- src/basic/FStar.Defensive.fst | 9 +-- src/class/FStar.Class.Binders.fst | 6 +- src/class/FStar.Class.Binders.fsti | 9 +-- ...ler.Set.fst => FStar.Compiler.FlatSet.fst} | 49 ++++++++++++++-- src/data/FStar.Compiler.FlatSet.fsti | 33 +++++++++++ src/data/FStar.Compiler.Set.fsti | 56 ------------------- ...r.Extraction.ML.RemoveUnusedParameters.fst | 9 +-- src/fstar/FStar.Interactive.Ide.fst | 4 +- src/parser/FStar.Parser.Dep.fst | 2 +- .../FStar.SMTEncoding.EncodeTerm.fst | 9 +-- src/smtencoding/FStar.SMTEncoding.Term.fst | 3 +- src/syntax/FStar.Syntax.DsEnv.fst | 30 +++++----- src/syntax/FStar.Syntax.Free.fst | 32 +++++------ src/syntax/FStar.Syntax.Free.fsti | 24 ++++---- src/syntax/FStar.Syntax.Resugar.fst | 11 ++-- src/syntax/FStar.Syntax.Resugar.fsti | 4 +- src/syntax/FStar.Syntax.Syntax.fst | 20 +++---- src/syntax/FStar.Syntax.Syntax.fsti | 16 +++--- src/syntax/FStar.Syntax.Util.fst | 14 +++-- src/tactics/FStar.Tactics.Monad.fst | 6 +- src/tactics/FStar.Tactics.V1.Basic.fst | 28 +++++----- src/tactics/FStar.Tactics.V2.Basic.fst | 33 +++++------ src/tosyntax/FStar.ToSyntax.ToSyntax.fst | 51 ++++++++--------- src/typechecker/FStar.TypeChecker.Core.fst | 5 +- src/typechecker/FStar.TypeChecker.DMFF.fst | 12 ++-- .../FStar.TypeChecker.DeferredImplicits.fst | 10 ++-- src/typechecker/FStar.TypeChecker.Env.fst | 24 ++++---- src/typechecker/FStar.TypeChecker.Env.fsti | 6 +- .../FStar.TypeChecker.Generalize.fst | 29 +++++----- .../FStar.TypeChecker.Positivity.fst | 4 +- src/typechecker/FStar.TypeChecker.Rel.fst | 54 +++++++++--------- src/typechecker/FStar.TypeChecker.Tc.fst | 4 +- src/typechecker/FStar.TypeChecker.TcTerm.fst | 23 ++++---- src/typechecker/FStar.TypeChecker.Util.fst | 6 +- 34 files changed, 339 insertions(+), 296 deletions(-) rename src/data/{FStar.Compiler.Set.fst => FStar.Compiler.FlatSet.fst} (54%) create mode 100644 src/data/FStar.Compiler.FlatSet.fsti delete mode 100644 src/data/FStar.Compiler.Set.fsti diff --git a/src/basic/FStar.Defensive.fst b/src/basic/FStar.Defensive.fst index d176b1c04d5..2333de123eb 100644 --- a/src/basic/FStar.Defensive.fst +++ b/src/basic/FStar.Defensive.fst @@ -9,6 +9,7 @@ open FStar.Class.Ord open FStar.Errors open FStar.Errors.Msg open FStar.Pprint +open FStar.Class.Setlike let () = let open FStar.Syntax.Print in () @@ -24,24 +25,24 @@ instance pp_bv : pretty FStar.Syntax.Syntax.bv = { pp = (fun bv -> arbitrary_string (show bv)); } -instance pp_set #a (_ : ord a) (_ : pretty a) : Tot (pretty (Set.set a)) = { +instance pp_set #a (_ : ord a) (_ : pretty a) : Tot (pretty (FlatSet.t a)) = { pp = (fun s -> let doclist (ds : list Pprint.document) : Pprint.document = surround_separate 2 0 (doc_of_string "[]") lbracket (semi ^^ break_ 1) rbracket ds in - doclist (Set.elems s |> List.map pp)) + doclist (elems s |> List.map pp)) } let __def_check_scoped rng msg env thing = let free = freeNames thing in let scope = boundNames env in - if not (Set.subset free scope) then + if not (subset free scope) then Errors.log_issue_doc rng (Errors.Warning_Defensive, [ text "Internal: term is not well-scoped " ^/^ parens (doc_of_string msg); text "t =" ^/^ pp thing; text "FVs =" ^/^ pp free; text "Scope =" ^/^ pp scope; - text "Diff =" ^/^ pp (Set.diff free scope); + text "Diff =" ^/^ pp (diff free scope); ]) let def_check_scoped rng msg env thing = diff --git a/src/class/FStar.Class.Binders.fst b/src/class/FStar.Class.Binders.fst index 7f48a989d73..da81f383375 100644 --- a/src/class/FStar.Class.Binders.fst +++ b/src/class/FStar.Class.Binders.fst @@ -4,7 +4,7 @@ open FStar.Compiler open FStar.Compiler.Effect open FStar.Compiler.Range open FStar.Compiler.Util -open FStar.Compiler.Set +open FStar.Compiler.FlatSet open FStar.Syntax.Syntax module F = FStar.Syntax.Free open FStar.Errors @@ -18,12 +18,12 @@ instance hasNames_comp : hasNames comp = { freeNames = (fun c -> match c.n with | Total t | GTotal t -> F.names t - | Comp ct -> List.fold_left Set.union (Set.empty ()) + | Comp ct -> List.fold_left union (empty ()) (F.names ct.result_typ :: (List.map (fun (a,_) -> F.names a) ct.effect_args))) } instance hasBinders_list_bv = { - boundNames = Set.from_list; + boundNames = from_list; } instance hasBinders_set_bv = { diff --git a/src/class/FStar.Class.Binders.fsti b/src/class/FStar.Class.Binders.fsti index ae5ee389b2c..2c4c13bbef7 100644 --- a/src/class/FStar.Class.Binders.fsti +++ b/src/class/FStar.Class.Binders.fsti @@ -1,19 +1,20 @@ module FStar.Class.Binders open FStar.Compiler.Util -open FStar.Compiler.Set +open FStar.Compiler.FlatSet open FStar.Syntax.Syntax +(* TODO: should be for any setlike *) class hasNames (a:Type) = { - freeNames : a -> set bv; + freeNames : a -> flat_set bv; } class hasBinders (a:Type) = { - boundNames : a -> set bv; + boundNames : a -> flat_set bv; } instance val hasNames_term : hasNames term instance val hasNames_comp : hasNames comp instance val hasBinders_list_bv : hasBinders (list bv) -instance val hasBinders_set_bv : hasBinders (set bv) +instance val hasBinders_set_bv : hasBinders (flat_set bv) diff --git a/src/data/FStar.Compiler.Set.fst b/src/data/FStar.Compiler.FlatSet.fst similarity index 54% rename from src/data/FStar.Compiler.Set.fst rename to src/data/FStar.Compiler.FlatSet.fst index 7dd53f4f918..1d8a54231be 100644 --- a/src/data/FStar.Compiler.Set.fst +++ b/src/data/FStar.Compiler.FlatSet.fst @@ -16,7 +16,7 @@ limitations under the License. *) -module FStar.Compiler.Set +module FStar.Compiler.FlatSet open FStar.Class.Ord open FStar.Compiler.Effect @@ -29,46 +29,85 @@ the exact order of `elems` provided by this list representation, so we cannot (yet) do big changes here. *) (* Inv: no duplication. We are left-biased. *) -let set t = list t +let flat_set t = list t +val add (#a:Type) {| ord a |} : a -> flat_set a -> flat_set a let rec add x s = match s with | [] -> [x] | y::yy -> if x =? y then s else y :: add x yy +val empty (#a:Type) : unit -> flat_set a let empty () = [] +val from_list (#a:Type) {| ord a |} : list a -> flat_set a let from_list xs = dedup xs +val mem (#a:Type) {| ord a |} : a -> flat_set a -> bool let mem x s = List.existsb (fun y -> x =? y) s +val singleton (#a:Type) {| ord a |} : a -> flat_set a let singleton x = [x] +val is_empty (#a:Type) : flat_set a -> bool let is_empty s = Nil? s +val addn (#a:Type) {| ord a |} : list a -> flat_set a -> flat_set a let addn xs ys = List.fold_right add xs ys +val remove (#a:Type) {| ord a |} : a -> flat_set a -> flat_set a let rec remove x s = match s with | [] -> [] | y::yy -> if x =? y then yy else y :: remove x yy +val elems (#a:Type) : flat_set a -> list a let elems s = s +val for_all (#a:Type) : (a -> bool) -> flat_set a -> bool let for_all p s = elems s |> List.for_all p + +val for_any (#a:Type) : (a -> bool) -> flat_set a -> bool let for_any p s = elems s |> List.existsb p +val subset (#a:Type) {| ord a |} : flat_set a -> flat_set a -> bool let subset s1 s2 = for_all (fun y -> mem y s2) s1 + +val equal (#a:Type) {| ord a |} : flat_set a -> flat_set a -> bool let equal s1 s2 = sort s1 =? sort s2 +val union (#a:Type) {| ord a |} : flat_set a -> flat_set a -> flat_set a let union s1 s2 = List.fold_left (fun s x -> add x s) s1 s2 -let inter s1 s2 = List.filter (fun y -> mem y s2) s1 -let diff s1 s2 = List.filter (fun y -> not (mem y s2)) s1 +val inter (#a:Type) {| ord a |} : flat_set a -> flat_set a -> flat_set a +let inter s1 s2 = List.filter (fun y -> mem y s2) s1 +val diff (#a:Type) {| ord a |} : flat_set a -> flat_set a -> flat_set a +let diff s1 s2 = List.filter (fun y -> not (mem y s2)) s1 +val collect (#a #b:Type) {| ord b |} : (a -> flat_set b) -> list a -> flat_set b let collect f l = List.fold_right (fun x acc -> f x `union` acc) l (empty ()) -instance showable_set (a:Type) (_ : ord a) (_ : showable a) : Tot (showable (set a)) = { +instance showable_set (a:Type) (_ : ord a) (_ : showable a) : Tot (showable (flat_set a)) = { show = (fun s -> show (elems s)); } + +instance setlike_flat_set (a:Type) (_ : ord a) : Tot (setlike a (flat_set a)) = { + empty = empty; + from_list = from_list; + singleton = singleton; + is_empty = is_empty; + add = add; + addn = addn; + remove = remove; + mem = mem; + elems = elems; + for_all = for_all; + for_any = for_any; + subset = subset; + equal = equal; + union = union; + inter = inter; + diff = diff; + collect = collect; +} diff --git a/src/data/FStar.Compiler.FlatSet.fsti b/src/data/FStar.Compiler.FlatSet.fsti new file mode 100644 index 00000000000..fbc5939fe01 --- /dev/null +++ b/src/data/FStar.Compiler.FlatSet.fsti @@ -0,0 +1,33 @@ +(* + Copyright 2008-2017 Microsoft Research + + Authors: Aseem Rastogi, Nikhil Swamy, Jonathan Protzenko + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + +module FStar.Compiler.FlatSet + +open FStar.Class.Ord +open FStar.Class.Show +open FStar.Class.Setlike +include FStar.Class.Setlike + +val flat_set (a:Type0) : Type0 +type t = flat_set + +instance +val showable_set (a:Type) (_ : ord a) (_ : showable a) : Tot (showable (flat_set a)) + +instance +val setlike_flat_set (a:Type0) (_ : ord a) : Tot (setlike a (flat_set a)) diff --git a/src/data/FStar.Compiler.Set.fsti b/src/data/FStar.Compiler.Set.fsti deleted file mode 100644 index e34239b9c2a..00000000000 --- a/src/data/FStar.Compiler.Set.fsti +++ /dev/null @@ -1,56 +0,0 @@ -(* - Copyright 2008-2017 Microsoft Research - - Authors: Aseem Rastogi, Nikhil Swamy, Jonathan Protzenko - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. -*) - -module FStar.Compiler.Set - -open FStar.Class.Ord -open FStar.Class.Show - -val set (a:Type0) : Type0 - -type t = set - -val empty (#a:Type) {| ord a |} () : set a -val singleton (#a:Type) {| ord a |} (x:a) : set a - -val is_empty (#a:Type) {| ord a |} (s:set a) : bool - -val from_list (#a:Type) {| ord a |} (l:list a) : set a -val elems (#a:Type) {| ord a |} (s:set a) : list a - -val add (#a:Type) {| ord a |} (x:a) (s:set a) : set a -val addn (#a:Type) {| ord a |} (x:list a) (s:set a) : set a - -val remove (#a:Type) {| ord a |} (x:a) (s:set a) : set a - -val mem (#a:Type) {| ord a |} (x:a) (s:set a) : bool - -val equal (#a:Type) {| ord a |} (s1:set a) (s2:set a) : bool - -val subset (#a:Type) {| ord a |} (s1:set a) (s2:set a) : bool - -val union (#a:Type) {| ord a |} (s1:set a) (s2:set a) : set a -val inter (#a:Type) {| ord a |} (s1:set a) (s2:set a) : set a -val diff (#a:Type) {| ord a |} (s1:set a) (s2:set a) : set a - -val collect (#a:Type) (#b:Type) {| ord b |} (f : a -> set b) (l : list a) : set b - -val for_all (#a:Type) {| ord a |} (p:(a -> bool)) (s:set a) : bool -val for_any (#a:Type) {| ord a |} (p:(a -> bool)) (s:set a) : bool - -instance val showable_set (a:Type) (_ : ord a) (_ : showable a) : Tot (showable (set a)) diff --git a/src/extraction/FStar.Extraction.ML.RemoveUnusedParameters.fst b/src/extraction/FStar.Extraction.ML.RemoveUnusedParameters.fst index a157982cb1f..828993a1273 100644 --- a/src/extraction/FStar.Extraction.ML.RemoveUnusedParameters.fst +++ b/src/extraction/FStar.Extraction.ML.RemoveUnusedParameters.fst @@ -25,6 +25,7 @@ open FStar.Compiler.Util open FStar.Const open FStar.BaseTypes open FStar.Extraction.ML.Syntax +open FStar.Class.Setlike (** This module implements a transformation on the FStar.Extraction.ML.Syntax @@ -75,12 +76,12 @@ let lookup_tyname (env:env_t) (name:mlpath) = BU.psmap_try_find env.tydef_map (string_of_mlpath name) (** Free variables of a type: Computed to check which parameters are used *) -type var_set = Set.set mlident -let empty_var_set : Set.set string = Set.empty () +type var_set = FlatSet.t mlident +let empty_var_set : FlatSet.t string = empty () let rec freevars_of_mlty' (vars:var_set) (t:mlty) = match t with | MLTY_Var i -> - Set.add i vars + add i vars | MLTY_Fun (t0, _, t1) -> freevars_of_mlty' (freevars_of_mlty' vars t0) t1 | MLTY_Named (tys, _) @@ -206,7 +207,7 @@ let elim_tydef (env:env_t) name metadata parameters mlty List.fold_left (fun (i, params, entry) param -> let p = param.ty_param_name in - if Set.mem p freevars + if mem p freevars then begin if must_eliminate i then begin diff --git a/src/fstar/FStar.Interactive.Ide.fst b/src/fstar/FStar.Interactive.Ide.fst index 022514d7d28..74ef6e21ba3 100644 --- a/src/fstar/FStar.Interactive.Ide.fst +++ b/src/fstar/FStar.Interactive.Ide.fst @@ -968,7 +968,7 @@ let st_cost = function type search_candidate = { sc_lid: lid; sc_typ: ref (option Syntax.Syntax.typ); - sc_fvars: ref (option (Set.t lid)) } + sc_fvars: ref (option (FlatSet.t lid)) } let sc_of_lid lid = { sc_lid = lid; sc_typ = Util.mk_ref None; @@ -1003,7 +1003,7 @@ let run_search st search_str = let found = match term.st_term with | NameContainsStr str -> Util.contains (string_of_lid candidate.sc_lid) str - | TypeContainsLid lid -> Set.mem lid (sc_fvars tcenv candidate) in + | TypeContainsLid lid -> Class.Setlike.mem lid (sc_fvars tcenv candidate) in found <> term.st_negate in let parse search_str = diff --git a/src/parser/FStar.Parser.Dep.fst b/src/parser/FStar.Parser.Dep.fst index d90736b626d..d3fce3581f0 100644 --- a/src/parser/FStar.Parser.Dep.fst +++ b/src/parser/FStar.Parser.Dep.fst @@ -39,7 +39,7 @@ open FStar.Class.Show module Const = FStar.Parser.Const module BU = FStar.Compiler.Util -module Set = FStar.Compiler.Set +module FlatSet = FStar.Compiler.FlatSet let profile f c = Profiling.profile f None c diff --git a/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst b/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst index 177b51681bb..44ed6c6c937 100644 --- a/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst +++ b/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst @@ -48,6 +48,7 @@ module TcUtil = FStar.TypeChecker.Util module U = FStar.Syntax.Util open FStar.Class.Show +open FStar.Class.Setlike (*---------------------------------------------------------------------------------*) (* *) @@ -223,8 +224,8 @@ let check_pattern_vars env vars pats = match pats with | [] -> () | hd::tl -> - let pat_vars = List.fold_left (fun out x -> Set.union out (Free.names x)) (Free.names hd) tl in - match vars |> BU.find_opt (fun ({binder_bv=b}) -> not(Set.mem b pat_vars)) with + let pat_vars = List.fold_left (fun out x -> union out (Free.names x)) (Free.names hd) tl in + match vars |> BU.find_opt (fun ({binder_bv=b}) -> not (mem b pat_vars)) with | None -> () | Some ({binder_bv=x}) -> let pos = List.fold_left (fun out t -> Range.union_ranges out t.pos) hd.pos tl in @@ -837,7 +838,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t issue #3028 *) let env0 = env in let fstar_fvs, (env, fv_decls, fv_vars, fv_tms, fv_guards) = - let fvs = Free.names t0 |> Set.elems in + let fvs = Free.names t0 |> elems in let getfreeV (t:term) : fv = match t.tm with @@ -1206,7 +1207,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t (* We need to compute all free variables of this lambda expression and parametrize the encoding wrt to them. See issue #3028 *) - let fvs = Free.names t0 |> Set.elems in + let fvs = Free.names t0 |> elems in let tms = List.map (lookup_term_var env) fvs in (List.map (fun _ -> Term_sort) fvs <: list sort), tms diff --git a/src/smtencoding/FStar.SMTEncoding.Term.fst b/src/smtencoding/FStar.SMTEncoding.Term.fst index caa0b727566..b321f9e4c6b 100644 --- a/src/smtencoding/FStar.SMTEncoding.Term.fst +++ b/src/smtencoding/FStar.SMTEncoding.Term.fst @@ -145,10 +145,11 @@ let fv_sort (x:fv) = let FV (_, sort, _) = x in sort let fv_force (x:fv) = let FV (_, _, force) = x in force let fv_eq (x:fv) (y:fv) = fv_name x = fv_name y let fvs_subset_of (x:fvs) (y:fvs) = + let open FStar.Class.Setlike in let cmp_fv x y = BU.compare (fv_name x) (fv_name y) in - Set.subset (Set.from_list x) (Set.from_list y) + subset (from_list x <: FlatSet.t fv) (from_list y) let freevar_eq x y = match x.tm, y.tm with | FreeV x, FreeV y -> fv_eq x y diff --git a/src/syntax/FStar.Syntax.DsEnv.fst b/src/syntax/FStar.Syntax.DsEnv.fst index 81317defd36..a62d068c3c5 100644 --- a/src/syntax/FStar.Syntax.DsEnv.fst +++ b/src/syntax/FStar.Syntax.DsEnv.fst @@ -27,7 +27,9 @@ open FStar.Syntax.Util open FStar.Parser open FStar.Ident open FStar.Errors + open FStar.Class.Show +open FStar.Class.Setlike let ugly_sigelt_to_string_hook : ref (sigelt -> string) = BU.mk_ref (fun _ -> "") let ugly_sigelt_to_string (se:sigelt) : string = !ugly_sigelt_to_string_hook se @@ -49,7 +51,7 @@ type scope_mod = | Top_level_def of ident (* top-level definition for an unqualified identifier x to be resolved as curmodule.x. *) | Record_or_dc of record_or_dc (* to honor interleavings of "open" and record definitions *) -type string_set = Set.t string +type string_set = FlatSet.t string type exported_id_kind = (* kinds of identifiers exported by a module *) | Exported_id_term_type (* term and type identifiers *) @@ -110,7 +112,7 @@ let transitive_exported_ids env lid = let module_name = Ident.string_of_lid lid in match BU.smap_try_find env.trans_exported_ids module_name with | None -> [] - | Some exported_id_set -> !(exported_id_set Exported_id_term_type) |> Set.elems + | Some exported_id_set -> !(exported_id_set Exported_id_term_type) |> elems let opens_and_abbrevs env : list (either open_module_or_namespace module_abbrev) = List.collect (function @@ -258,7 +260,7 @@ let find_in_module_with_includes | None -> true | Some mex -> let mexports = !(mex eikind) in - Set.mem idstr mexports + mem idstr mexports in let mincludes = match BU.smap_try_find env.includes mname with | None -> [] @@ -878,13 +880,13 @@ let extract_record (e:env) (new_globs: ref (list scope_mod)) = fun se -> match s match get_exported_id_set e modul with | Some my_ex -> let my_exported_ids = my_ex Exported_id_field in - let () = my_exported_ids := Set.add (string_of_id id) !my_exported_ids in + let () = my_exported_ids := add (string_of_id id) !my_exported_ids in (* also add the projector name *) let projname = mk_field_projector_name_from_ident constrname id |> ident_of_lid |> string_of_id in - let () = my_exported_ids := Set.add projname !my_exported_ids in + let () = my_exported_ids := add projname !my_exported_ids in () | None -> () (* current module was not prepared? should not happen *) in @@ -956,7 +958,7 @@ let try_lookup_dc_by_field_name env (fieldname:lident) = | Some r -> Some (set_lid_range (lid_of_ids (ns_of_lid r.typename @ [r.constrname])) (range_of_lid fieldname), r.is_record) | _ -> None -let string_set_ref_new () : ref (Set.t string) = BU.mk_ref (Set.empty ()) +let string_set_ref_new () : ref (FlatSet.t string) = BU.mk_ref (empty ()) let exported_id_set_new () = let term_type_set = string_set_ref_new () in let field_set = string_set_ref_new () in @@ -1038,7 +1040,7 @@ let push_sigelt' fail_on_dup env s = let () = match get_exported_id_set env modul with | Some f -> let my_exported_ids = f Exported_id_term_type in - my_exported_ids := Set.add (string_of_id (ident_of_lid lid)) !my_exported_ids + my_exported_ids := add (string_of_id (ident_of_lid lid)) !my_exported_ids | None -> () (* current module was not prepared? should not happen *) in let is_iface = env.iface && not env.admitted_iface in @@ -1102,9 +1104,9 @@ let push_include env ns = let update_exports (k: exported_id_kind) = let ns_ex = ! (ns_trans_exports k) in let ex = cur_exports k in - let () = ex := Set.diff (!ex) ns_ex in + let () = ex := diff (!ex) ns_ex in let trans_ex = cur_trans_exports k in - let () = trans_ex := Set.union (!trans_ex) ns_ex in + let () = trans_ex := union (!trans_ex) ns_ex in () in List.iter update_exports all_exported_id_kinds @@ -1193,7 +1195,7 @@ let finish env modul = let update_exports eikind = let cur_ex_set = ! (cur_ex eikind) in let cur_trans_ex_set_ref = cur_trans_ex eikind in - cur_trans_ex_set_ref := Set.union cur_ex_set (!cur_trans_ex_set_ref) + cur_trans_ex_set_ref := union cur_ex_set (!cur_trans_ex_set_ref) in List.iter update_exports all_exported_id_kinds | _ -> () @@ -1259,8 +1261,8 @@ type exported_ids = { exported_id_fields:list string } let as_exported_ids (e:exported_id_set) = - let terms = Set.elems (!(e Exported_id_term_type)) in - let fields = Set.elems (!(e Exported_id_field)) in + let terms = elems (!(e Exported_id_term_type)) in + let fields = elems (!(e Exported_id_field)) in {exported_id_terms=terms; exported_id_fields=fields} @@ -1269,9 +1271,9 @@ let as_exported_id_set (e:option exported_ids) = | None -> exported_id_set_new () | Some e -> let terms = - BU.mk_ref (Set.from_list e.exported_id_terms) in + BU.mk_ref (from_list e.exported_id_terms) in let fields = - BU.mk_ref (Set.from_list e.exported_id_fields) in + BU.mk_ref (from_list e.exported_id_fields) in function | Exported_id_term_type -> terms | Exported_id_field -> fields diff --git a/src/syntax/FStar.Syntax.Free.fst b/src/syntax/FStar.Syntax.Free.fst index 8c9f98f7ad5..b277c98c6d8 100644 --- a/src/syntax/FStar.Syntax.Free.fst +++ b/src/syntax/FStar.Syntax.Free.fst @@ -22,7 +22,7 @@ open FStar.Compiler.List open FStar open FStar.Compiler open FStar.Compiler.Util -open FStar.Compiler.Set +open FStar.Compiler.FlatSet open FStar.Syntax open FStar.Syntax.Syntax module Util = FStar.Compiler.Util @@ -62,7 +62,7 @@ type use_cache_t = | NoCache | Full -type free_vars_and_fvars = free_vars * set Ident.lident +type free_vars_and_fvars = free_vars * flat_set Ident.lident (* Snoc without duplicates *) val snoc : #a:Type -> {| deq a |} -> list a -> a -> list a @@ -85,7 +85,7 @@ let no_free_vars = { let singleton_fvar fv = fst no_free_vars, - Set.add fv.fv_name.v (new_fv_set ()) + add fv.fv_name.v (new_fv_set ()) let singleton_bv x = {fst no_free_vars with free_names=[x]}, snd no_free_vars let singleton_uv x = {fst no_free_vars with free_uvars=[x]}, snd no_free_vars @@ -98,7 +98,7 @@ let union (f1 : free_vars_and_fvars) (f2 : free_vars_and_fvars) = { free_univs=(fst f1).free_univs @@ (fst f2).free_univs; free_univ_names=(fst f1).free_univ_names @@ (fst f2).free_univ_names; //THE ORDER HERE IS IMPORTANT! //We expect the free_univ_names list to be in fifo order to get the right order of universe generalization -}, Set.union (snd f1) (snd f2) +}, union #Ident.lident (snd f1) (snd f2) let rec free_univs u = match Subst.compress_univ u with | U_zero @@ -240,7 +240,7 @@ and free_names_and_uvars t use_cache = if use_cache <> Full then t.vars := Some (fst n); n -and free_names_and_uvars_args args (acc:free_vars * set Ident.lident) use_cache = +and free_names_and_uvars_args args (acc:free_vars * flat_set Ident.lident) use_cache = args |> List.fold_left (fun n (x, _) -> union n (free_names_and_uvars x use_cache)) acc and free_names_and_uvars_comp c use_cache = @@ -294,20 +294,20 @@ and should_invalidate_cache n use_cache = //note use_cache is set false ONLY for fvars, which is not maintained at each AST node //see the comment above -let new_uv_set () : uvars = Set.empty () -let new_universe_uvar_set () : set universe_uvar = Set.empty () -let empty = Set.empty () +let new_uv_set () : uvars = empty () +let new_universe_uvar_set () : flat_set universe_uvar = empty () +let empty = empty () -let names t = Set.from_list (fst (free_names_and_uvars t Def)).free_names -let uvars t = Set.from_list (fst (free_names_and_uvars t Def)).free_uvars -let univs t = Set.from_list (fst (free_names_and_uvars t Def)).free_univs +let names t = from_list (fst (free_names_and_uvars t Def)).free_names +let uvars t = from_list (fst (free_names_and_uvars t Def)).free_uvars +let univs t = from_list (fst (free_names_and_uvars t Def)).free_univs -let univnames t = Set.from_list (fst (free_names_and_uvars t Def)).free_univ_names -let univnames_comp c = Set.from_list (fst (free_names_and_uvars_comp c Def)).free_univ_names +let univnames t = from_list (fst (free_names_and_uvars t Def)).free_univ_names +let univnames_comp c = from_list (fst (free_names_and_uvars_comp c Def)).free_univ_names let fvars t = snd (free_names_and_uvars t NoCache) let names_of_binders (bs:binders) = - Set.from_list ((fst (free_names_and_uvars_binders bs Def)).free_names) + from_list ((fst (free_names_and_uvars_binders bs Def)).free_names) -let uvars_uncached t = Set.from_list (fst (free_names_and_uvars t NoCache)).free_uvars -let uvars_full t = Set.from_list (fst (free_names_and_uvars t Full)).free_uvars +let uvars_uncached t = from_list (fst (free_names_and_uvars t NoCache)).free_uvars +let uvars_full t = from_list (fst (free_names_and_uvars t Full)).free_uvars diff --git a/src/syntax/FStar.Syntax.Free.fsti b/src/syntax/FStar.Syntax.Free.fsti index 10cfce41997..7cdc93c49fc 100644 --- a/src/syntax/FStar.Syntax.Free.fsti +++ b/src/syntax/FStar.Syntax.Free.fsti @@ -19,24 +19,24 @@ open Prims open FStar open FStar.Compiler open FStar.Compiler.Util -open FStar.Compiler.Set +open FStar.Compiler.FlatSet open FStar.Syntax open FStar.Syntax.Syntax val new_uv_set : unit -> uvars -val new_universe_uvar_set : unit -> set universe_uvar +val new_universe_uvar_set : unit -> flat_set universe_uvar -val empty: set bv -val names: term -> set bv -val uvars: term -> set ctx_uvar -val univs: term -> set universe_uvar -val univnames: term -> set univ_name -val univnames_comp: comp -> set univ_name -val fvars: term -> set Ident.lident -val names_of_binders: binders -> set bv +val empty: flat_set bv +val names: term -> flat_set bv +val uvars: term -> flat_set ctx_uvar +val univs: term -> flat_set universe_uvar +val univnames: term -> flat_set univ_name +val univnames_comp: comp -> flat_set univ_name +val fvars: term -> flat_set Ident.lident +val names_of_binders: binders -> flat_set bv -val uvars_uncached: term -> set ctx_uvar -val uvars_full: term -> set ctx_uvar +val uvars_uncached: term -> flat_set ctx_uvar +val uvars_full: term -> flat_set ctx_uvar (* Bad place for these instances. But they cannot be instance Syntax.Syntax since they reference the UF graph. *) diff --git a/src/syntax/FStar.Syntax.Resugar.fst b/src/syntax/FStar.Syntax.Resugar.fst index 639f879a2bc..9b2c2418380 100644 --- a/src/syntax/FStar.Syntax.Resugar.fst +++ b/src/syntax/FStar.Syntax.Resugar.fst @@ -27,6 +27,7 @@ open FStar.Const open FStar.Compiler.List open FStar.Parser.AST open FStar.Class.Monad +open FStar.Class.Setlike module I = FStar.Ident module S = FStar.Syntax.Syntax @@ -1052,9 +1053,9 @@ and resugar_binder' env (b:S.binder) r : option A.binder = A.mk_binder (A.Annotated (bv_as_unique_ident b.binder_bv, e)) r A.Type_level imp end -and resugar_bv_as_pat' env (v: S.bv) aqual (body_bv: Set.set bv) typ_opt = +and resugar_bv_as_pat' env (v: S.bv) aqual (body_bv: FlatSet.t bv) typ_opt = let mk a = A.mk_pattern a (S.range_of_bv v) in - let used = Set.mem v body_bv in + let used = mem v body_bv in let pat = mk (if used then A.PatVar (bv_as_unique_ident v, aqual, []) @@ -1070,7 +1071,7 @@ and resugar_bv_as_pat env (x:S.bv) qual body_bv: option A.pattern = (resugar_bqual env qual) (fun bq -> resugar_bv_as_pat' env x bq body_bv (Some <| SS.compress x.sort)) -and resugar_pat' env (p:S.pat) (branch_bv: Set.set bv) : A.pattern = +and resugar_pat' env (p:S.pat) (branch_bv: FlatSet.t bv) : A.pattern = (* We lose information when desugar PatAscribed to able to resugar it back *) let mk a = A.mk_pattern a p.p in let to_arg_qual bopt = // FIXME do (Some false) and None mean the same thing? @@ -1081,7 +1082,7 @@ and resugar_pat' env (p:S.pat) (branch_bv: Set.set bv) : A.pattern = //FIXME let might_be_used = match pattern.v with - | Pat_var bv -> Set.mem bv branch_bv + | Pat_var bv -> mem bv branch_bv | _ -> true in is_implicit && might_be_used) args) in let resugar_plain_pat_cons' fv args = @@ -1502,7 +1503,7 @@ let resugar_sigelt se : option A.decl = let resugar_comp (c:S.comp) : A.term = noenv resugar_comp' c -let resugar_pat (p:S.pat) (branch_bv: Set.set bv) : A.pattern = +let resugar_pat (p:S.pat) (branch_bv: FlatSet.t bv) : A.pattern = noenv resugar_pat' p branch_bv let resugar_binder (b:S.binder) r : option A.binder = diff --git a/src/syntax/FStar.Syntax.Resugar.fsti b/src/syntax/FStar.Syntax.Resugar.fsti index c4d40395dfa..cdf7515409d 100644 --- a/src/syntax/FStar.Syntax.Resugar.fsti +++ b/src/syntax/FStar.Syntax.Resugar.fsti @@ -36,7 +36,7 @@ module DsEnv = FStar.Syntax.DsEnv val resugar_term: S.term -> A.term val resugar_sigelt: S.sigelt -> option A.decl val resugar_comp: S.comp -> A.term -val resugar_pat: S.pat -> Set.t S.bv -> A.pattern +val resugar_pat: S.pat -> FlatSet.t S.bv -> A.pattern val resugar_universe: S.universe -> Range.range -> A.term val resugar_binder: S.binder -> Range.range -> option A.binder val resugar_tscheme: S.tscheme -> A.decl @@ -45,7 +45,7 @@ val resugar_eff_decl: Range.range -> list S.qualifier -> eff_decl -> A.decl val resugar_term': DsEnv.env -> S.term -> A.term val resugar_sigelt': DsEnv.env -> S.sigelt -> option A.decl val resugar_comp': DsEnv.env -> S.comp -> A.term -val resugar_pat': DsEnv.env -> S.pat -> Set.t S.bv -> A.pattern +val resugar_pat': DsEnv.env -> S.pat -> FlatSet.t S.bv -> A.pattern val resugar_universe': DsEnv.env -> S.universe -> Range.range -> A.term val resugar_binder': DsEnv.env -> S.binder -> Range.range -> option A.binder val resugar_tscheme': DsEnv.env -> S.tscheme -> A.decl diff --git a/src/syntax/FStar.Syntax.Syntax.fst b/src/syntax/FStar.Syntax.Syntax.fst index b9991d214ab..e24a356bd84 100644 --- a/src/syntax/FStar.Syntax.Syntax.fst +++ b/src/syntax/FStar.Syntax.Syntax.fst @@ -29,13 +29,13 @@ open FStar.VConfig open FStar.Class.Ord open FStar.Class.HasRange - +open FStar.Class.Setlike module O = FStar.Options module PC = FStar.Parser.Const module Err = FStar.Errors module GS = FStar.GenSym -module Set = FStar.Compiler.Set +module FlatSet = FStar.Compiler.FlatSet let rec emb_typ_to_string = function | ET_abstract -> "abstract" @@ -160,18 +160,18 @@ instance ord_fv : ord lident = let syn p k f = f k p let mk_fvs () = Util.mk_ref None let mk_uvs () = Util.mk_ref None -let new_bv_set () : Set.t bv = Set.empty () -let new_id_set () : Set.t ident = Set.empty () -let new_fv_set () : Set.t lident = Set.empty () -let new_universe_names_set () : Set.t univ_name = Set.empty () +let new_bv_set () : FlatSet.t bv = empty () +let new_id_set () : FlatSet.t ident = empty () +let new_fv_set () : FlatSet.t lident = empty () +let new_universe_names_set () : FlatSet.t univ_name = empty () let no_names = new_bv_set() let no_fvars = new_fv_set() let no_universe_names = new_universe_names_set () //let memo_no_uvs = Util.mk_ref (Some no_uvs) //let memo_no_names = Util.mk_ref (Some no_names) -let freenames_of_list l = Set.addn l no_names -let list_of_freenames (fvs:freenames) = Set.elems fvs +let freenames_of_list l = addn l no_names +let list_of_freenames (fvs:freenames) = elems fvs (* Constructors for each term form; NO HASH CONSING; just makes all the auxiliary data at each node *) let mk (t:'a) r = { @@ -295,10 +295,10 @@ let is_top_level = function | _ -> false let freenames_of_binders (bs:binders) : freenames = - List.fold_right (fun b out -> Set.add b.binder_bv out) bs no_names + List.fold_right (fun b out -> add b.binder_bv out) bs no_names let binders_of_list fvs : binders = (fvs |> List.map (fun t -> mk_binder t)) -let binders_of_freenames (fvs:freenames) = Set.elems fvs |> binders_of_list +let binders_of_freenames (fvs:freenames) = elems fvs |> binders_of_list let is_bqual_implicit = function Some (Implicit _) -> true | _ -> false let is_aqual_implicit = function Some { aqual_implicit = b } -> b | _ -> false let is_bqual_implicit_or_meta = function Some (Implicit _) | Some (Meta _) -> true | _ -> false diff --git a/src/syntax/FStar.Syntax.Syntax.fsti b/src/syntax/FStar.Syntax.Syntax.fsti index b534081360b..78d8bdc9299 100644 --- a/src/syntax/FStar.Syntax.Syntax.fsti +++ b/src/syntax/FStar.Syntax.Syntax.fsti @@ -196,7 +196,7 @@ and uvar_decoration = { } and uvar = Unionfind.p_uvar (option term * uvar_decoration) * version * Range.range -and uvars = Set.t ctx_uvar +and uvars = FlatSet.t ctx_uvar and match_returns_ascription = binder * ascription (* as x returns C|t *) and branch = pat * option term * term (* optional when clause in each branch *) and ascription = either term comp * option term * bool (* e <: t [by tac] or e <: C [by tac] *) @@ -356,7 +356,7 @@ and subst_elt = | NT of bv * term (* NT x t: replace a local name with a term t *) | UN of int * universe (* UN u v: replace universes variable u with universe term v *) | UD of univ_name * int (* UD x i: replace universe name x with de Bruijn index i *) -and freenames = Set.t bv +and freenames = FlatSet.t bv and syntax 'a = { n:'a; pos:Range.range; @@ -751,10 +751,10 @@ val lookup_aq : bv -> antiquotations -> term // This is set in FStar.Main.main, where all modules are in-scope. val lazy_chooser : ref (option (lazy_kind -> lazyinfo -> term)) -val new_bv_set: unit -> Set.t bv -val new_id_set: unit -> Set.t ident -val new_fv_set: unit -> Set.t lident -val new_universe_names_set: unit -> Set.t univ_name +val new_bv_set: unit -> FlatSet.t bv +val new_id_set: unit -> FlatSet.t ident +val new_fv_set: unit -> FlatSet.t lident +val new_universe_names_set: unit -> FlatSet.t univ_name val mod_name: modul -> lident @@ -805,8 +805,8 @@ val is_teff: term -> bool val is_type: term -> bool val no_names: freenames -val no_universe_names: Set.t univ_name -val no_fvars: Set.t lident +val no_universe_names: FlatSet.t univ_name +val no_fvars: FlatSet.t lident val freenames_of_list: list bv -> freenames val freenames_of_binders: binders -> freenames diff --git a/src/syntax/FStar.Syntax.Util.fst b/src/syntax/FStar.Syntax.Util.fst index d4689e774c3..bd075a0a1c9 100644 --- a/src/syntax/FStar.Syntax.Util.fst +++ b/src/syntax/FStar.Syntax.Util.fst @@ -34,6 +34,7 @@ module PC = FStar.Parser.Const open FStar.Class.Show open FStar.Class.Monad +open FStar.Class.Setlike (********************************************************************************) (**************************Utilities for identifiers ****************************) @@ -107,7 +108,8 @@ let null_binders_of_tks (tks:list (typ * bqual)) : binders = let binders_of_tks (tks:list (typ * bqual)) : binders = tks |> List.map (fun (t, imp) -> mk_binder_with_attrs (new_bv (Some t.pos) t) imp None []) -let binders_of_freevars fvs = Set.elems fvs |> List.map mk_binder +let binders_of_freevars (fvs : FlatSet.t bv) = + Class.Setlike.elems fvs |> List.map mk_binder let mk_subst s = [s] @@ -1114,11 +1116,11 @@ let let_rec_arity (lb:letbinding) : int * option (list bool) = match d with | Decreases_lex l -> l |> List.fold_left (fun s t -> - Set.union s (FStar.Syntax.Free.names t)) (Set.empty ()) + union s (FStar.Syntax.Free.names t)) (empty #bv ()) | Decreases_wf (rel, e) -> - Set.union (FStar.Syntax.Free.names rel) (FStar.Syntax.Free.names e) in + union (Free.names rel) (Free.names e) in Common.tabulate n_univs (fun _ -> false) - @ (bs |> List.map (fun b -> Set.mem b.binder_bv d_bvs))) + @ (bs |> List.map (fun b -> mem b.binder_bv d_bvs))) let abs_formals_maybe_unascribe_body maybe_unascribe t = let subst_lcomp_opt s l = match l with @@ -1458,7 +1460,7 @@ let un_squash t = | _ -> failwith "impossible" in // A bit paranoid, but need this check for terms like `u:unit{u == ()}` - if Set.mem b.binder_bv (Free.names p) + if mem b.binder_bv (Free.names p) then None else Some p | _ -> None @@ -1530,7 +1532,7 @@ let arrow_one (t:typ) : option (binder * comp) = Some (b, c)) let is_free_in (bv:bv) (t:term) : bool = - Set.mem bv (FStar.Syntax.Free.names t) + mem bv (FStar.Syntax.Free.names t) let action_as_lb eff_lid a pos = let lb = diff --git a/src/tactics/FStar.Tactics.Monad.fst b/src/tactics/FStar.Tactics.Monad.fst index 0243d28e258..838dcd834cf 100644 --- a/src/tactics/FStar.Tactics.Monad.fst +++ b/src/tactics/FStar.Tactics.Monad.fst @@ -28,9 +28,11 @@ open FStar.Tactics.Types open FStar.Tactics.Result open FStar.Tactics.Printing open FStar.Tactics.Common -open FStar.Class.Show open FStar.Errors.Msg +open FStar.Class.Show +open FStar.Class.Setlike + module O = FStar.Options module BU = FStar.Compiler.Util module Err = FStar.Errors @@ -53,7 +55,7 @@ let is_goal_safe_as_well_typed (g:goal) = List.for_all (fun uv -> match UF.find uv.ctx_uvar_head with - | Some t -> Set.is_empty (FStar.Syntax.Free.uvars t) + | Some t -> is_empty (FStar.Syntax.Free.uvars t) | _ -> false) (U.ctx_uvar_typedness_deps uv) in diff --git a/src/tactics/FStar.Tactics.V1.Basic.fst b/src/tactics/FStar.Tactics.V1.Basic.fst index bfdff0c017c..eec1d385122 100644 --- a/src/tactics/FStar.Tactics.V1.Basic.fst +++ b/src/tactics/FStar.Tactics.V1.Basic.fst @@ -60,6 +60,8 @@ module Core = FStar.TypeChecker.Core module PO = FStar.TypeChecker.Primops open FStar.Class.Monad +open FStar.Class.Setlike + let ret #a (x:a) : tac a = return x let bind #a #b : tac a -> (a -> tac b) -> tac b = ( let! ) let idtac : tac unit = return () @@ -182,7 +184,7 @@ let dump_all (print_resolved:bool) (msg:string) : tac unit = let dump_uvars_of (g:goal) (msg:string) : tac unit = mk_tac (fun ps -> - let uvs = SF.uvars (goal_type g) |> Set.elems in + let uvs = SF.uvars (goal_type g) |> elems in let gs = List.map (goal_of_ctx_uvar g) uvs in let gs = List.filter (fun g -> not (check_goal_solved g)) gs in let ps' = { ps with smt_goals = [] ; goals = gs } in @@ -383,8 +385,8 @@ let __do_unify_wflags | Check_none -> Free.new_uv_set () | Check_left_only -> Free.uvars t1 | Check_right_only -> Free.uvars t2 - | Check_both -> Set.union (Free.uvars t1) (Free.uvars t2)) - |> Set.elems in + | Check_both -> union (Free.uvars t1) (Free.uvars t2)) + |> elems in match! catch (//restore UF graph in case anything fails @@ -473,7 +475,7 @@ let do_match (must_tot:bool) (env:Env.env) (t1:term) (t2:term) : tac bool = bind (do_unify_aux must_tot Check_right_only env t1 t2) (fun r -> if r then begin let uvs2 = SF.uvars_uncached t1 in - if not (Set.equal uvs1 uvs2) + if not (equal uvs1 uvs2) then (UF.rollback tx; ret false) else ret true end @@ -494,7 +496,7 @@ let do_match_on_lhs (must_tot:bool) (env:Env.env) (t1:term) (t2:term) : tac bool bind (do_unify_aux must_tot Check_right_only env t1 t2) (fun r -> if r then begin let uvs2 = SF.uvars_uncached lhs in - if not (Set.equal uvs1 uvs2) + if not (equal uvs1 uvs2) then (UF.rollback tx; ret false) else ret true end @@ -984,11 +986,11 @@ let t_apply (uopt:bool) (only_match:bool) (tc_resolved_uvars:bool) (tm:term) : t let w = List.fold_right (fun (uvt, q, _) w -> U.mk_app w [(uvt, q)]) uvs tm in let uvset = List.fold_right - (fun (_, _, uv) s -> Set.union s (SF.uvars (U.ctx_uvar_typ uv))) + (fun (_, _, uv) s -> union s (SF.uvars (U.ctx_uvar_typ uv))) uvs (SF.new_uv_set ()) in - let free_in_some_goal uv = Set.mem uv uvset in + let free_in_some_goal uv = mem uv uvset in solve' goal w ;! // //process uvs @@ -1102,7 +1104,7 @@ let t_apply_lemma (noinst:bool) (noinst_lhs:bool) let goal_sc = should_check_goal_uvar goal in solve' goal U.exp_unit ;! let is_free_uvar uv t = - let free_uvars = List.map (fun x -> x.ctx_uvar_head) (Set.elems (SF.uvars t)) in + let free_uvars = List.map (fun x -> x.ctx_uvar_head) (elems (SF.uvars t)) in List.existsML (fun u -> UF.equiv u uv) free_uvars in let appears uv goals = List.existsML (fun g' -> is_free_uvar uv (goal_type g')) goals in @@ -1298,7 +1300,7 @@ let revert () : tac unit = let g = mk_goal env' u_r goal.opts goal.is_guard goal.label in replace_cur g -let free_in bv t = Set.mem bv (SF.names t) +let free_in bv t = mem bv (SF.names t) let clear (b : binder) : tac unit = let bv = b.binder_bv in @@ -1391,7 +1393,7 @@ let _t_trefl (allow_guards:bool) (l : term) (r : term) : tac unit = | Inl (u, _, _) -> is_uvar_untyped_or_already_checked u in let t = U.ctx_uvar_typ g.goal_ctx_uvar in - let uvars = Set.elems (FStar.Syntax.Free.uvars t) in + let uvars = elems (FStar.Syntax.Free.uvars t) in if BU.for_all is_uvar_untyped_or_already_checked uvars then skip_register //all the uvars are already checked or untyped else ( @@ -2287,7 +2289,7 @@ let t_smt_sync (vcfg : vconfig) : tac unit = wrap_err "t_smt_sync" <| ( let free_uvars (tm : term) : tac (list Z.t) = idtac ;! - let uvs = Syntax.Free.uvars_uncached tm |> Set.elems |> List.map (fun u -> Z.of_int_fs (UF.uvar_id u.ctx_uvar_head)) in + let uvs = Syntax.Free.uvars_uncached tm |> elems |> List.map (fun u -> Z.of_int_fs (UF.uvar_id u.ctx_uvar_head)) in ret uvs (***** Builtins used in the meta DSL framework *****) @@ -2317,8 +2319,8 @@ let refl_typing_builtin_wrapper (f:unit -> 'a) : tac (option 'a & issues) = else ret (r, errs) let no_uvars_in_term (t:term) : bool = - t |> Free.uvars |> Set.is_empty && - t |> Free.univs |> Set.is_empty + t |> Free.uvars |> is_empty && + t |> Free.univs |> is_empty let no_uvars_in_g (g:env) : bool = g.gamma |> BU.for_all (function diff --git a/src/tactics/FStar.Tactics.V2.Basic.fst b/src/tactics/FStar.Tactics.V2.Basic.fst index f27163adb27..37e08e1862f 100644 --- a/src/tactics/FStar.Tactics.V2.Basic.fst +++ b/src/tactics/FStar.Tactics.V2.Basic.fst @@ -63,6 +63,7 @@ module PO = FStar.TypeChecker.Primops open FStar.Class.Show open FStar.Class.Monad open FStar.Class.PP +open FStar.Class.Setlike let compress (t:term) : tac term = return ();! @@ -156,7 +157,7 @@ let dump_all (print_resolved:bool) (msg:string) : tac unit = let dump_uvars_of (g:goal) (msg:string) : tac unit = mk_tac (fun ps -> - let uvs = SF.uvars (goal_type g) |> Set.elems in // Set.elems order dependent but OK + let uvs = SF.uvars (goal_type g) |> elems in // elems order dependent but OK let gs = List.map (goal_of_ctx_uvar g) uvs in let gs = List.filter (fun g -> not (check_goal_solved g)) gs in let ps' = { ps with smt_goals = [] ; goals = gs } in @@ -366,8 +367,8 @@ let __do_unify_wflags | Check_none -> Free.new_uv_set () | Check_left_only -> Free.uvars t1 | Check_right_only -> Free.uvars t2 - | Check_both -> Set.union (Free.uvars t1) (Free.uvars t2)) - |> Set.elems /// GGG order dependent but does not seem too bad + | Check_both -> union (Free.uvars t1) (Free.uvars t2)) + |> elems /// GGG order dependent but does not seem too bad in match! @@ -457,7 +458,7 @@ let do_match (must_tot:bool) (env:Env.env) (t1:term) (t2:term) : tac bool = let! r = do_unify_aux must_tot Check_right_only env t1 t2 in if r then begin let uvs2 = SF.uvars_uncached t1 in - if not (Set.equal uvs1 uvs2) + if not (equal uvs1 uvs2) then (UF.rollback tx; return false) else return true end @@ -477,7 +478,7 @@ let do_match_on_lhs (must_tot:bool) (env:Env.env) (t1:term) (t2:term) : tac bool let! r = do_unify_aux must_tot Check_right_only env t1 t2 in if r then begin let uvs2 = SF.uvars_uncached lhs in - if not (Set.equal uvs1 uvs2) + if not (equal uvs1 uvs2) then (UF.rollback tx; return false) else return true end @@ -976,7 +977,7 @@ let t_apply (uopt:bool) (only_match:bool) (tc_resolved_uvars:bool) (tm:term) : t (Rel.guard_to_string e guard)) ;! // Focus helps keep the goal order let typ = bnorm e typ in - if only_match && not (Set.is_empty (Free.uvars_uncached typ)) then + if only_match && not (is_empty (Free.uvars_uncached typ)) then fail "t_apply: only_match is on, but the type of the term to apply is not a uvar" else return ();! let! uvs = try_unify_by_application (Some should_check) only_match e typ (goal_type goal) (rangeof goal) in @@ -986,11 +987,11 @@ let t_apply (uopt:bool) (only_match:bool) (tc_resolved_uvars:bool) (tm:term) : t let w = List.fold_right (fun (uvt, q, _) w -> U.mk_app w [(uvt, q)]) uvs tm in let uvset = List.fold_right - (fun (_, _, uv) s -> Set.union s (SF.uvars (U.ctx_uvar_typ uv))) + (fun (_, _, uv) s -> union s (SF.uvars (U.ctx_uvar_typ uv))) uvs (SF.new_uv_set ()) in - let free_in_some_goal uv = Set.mem uv uvset in + let free_in_some_goal uv = mem uv uvset in solve' goal w ;! // //process uvs @@ -1105,7 +1106,7 @@ let t_apply_lemma (noinst:bool) (noinst_lhs:bool) let goal_sc = should_check_goal_uvar goal in solve' goal U.exp_unit ;! let is_free_uvar uv t = - Set.for_any (fun u -> UF.equiv u.ctx_uvar_head uv) (SF.uvars t) + for_any (fun u -> UF.equiv u.ctx_uvar_head uv) (SF.uvars t) in let appears uv goals = List.existsML (fun g' -> is_free_uvar uv (goal_type g')) goals in let checkone t goals = @@ -1301,7 +1302,7 @@ let revert () : tac unit = let g = mk_goal env' u_r goal.opts goal.is_guard goal.label in replace_cur g -let free_in bv t = Set.mem bv (SF.names t) +let free_in bv t = mem bv (SF.names t) let clear (b : RD.binding) : tac unit = let bv = binding_to_bv b in @@ -1395,7 +1396,7 @@ let _t_trefl (allow_guards:bool) (l : term) (r : term) : tac unit = in let t = U.ctx_uvar_typ g.goal_ctx_uvar in let uvars = FStar.Syntax.Free.uvars t in - if Set.for_all is_uvar_untyped_or_already_checked uvars + if for_all is_uvar_untyped_or_already_checked uvars then skip_register //all the uvars are already checked or untyped else ( let head, args = @@ -2109,7 +2110,7 @@ let t_smt_sync (vcfg : vconfig) : tac unit = wrap_err "t_smt_sync" <| ( let free_uvars (tm : term) : tac (list Z.t) = return ();! let uvs = Free.uvars_uncached tm - |> Set.elems // GGG bad, order dependent, but userspace does not have sets + |> elems // GGG bad, order dependent, but userspace does not have sets |> List.map (fun u -> Z.of_int_fs (UF.uvar_id u.ctx_uvar_head)) in return uvs @@ -2228,11 +2229,11 @@ let refl_typing_builtin_wrapper (label:string) (f:unit -> 'a & list (env & typ)) return (o, errs) let no_uvars_in_term (t:term) : bool = - t |> Free.uvars |> Set.is_empty && - t |> Free.univs |> Set.is_empty + t |> Free.uvars |> is_empty && + t |> Free.univs |> is_empty let no_univ_uvars_in_term (t:term) : bool = - t |> Free.univs |> Set.is_empty + t |> Free.univs |> is_empty let no_uvars_in_g (g:env) : bool = g.gamma |> BU.for_all (function @@ -2693,7 +2694,7 @@ let refl_try_unify (g:env) (uvs:list (bv & typ)) (t0 t1:term) let allow_uvars = true in let allow_names = true in let t = SC.deep_compress allow_uvars allow_names t in - if t |> Syntax.Free.uvars_full |> Set.is_empty + if t |> Syntax.Free.uvars_full |> is_empty then (bv, t)::l else l | None -> l diff --git a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst index be4e0cdd8fd..6a2203c8230 100644 --- a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst +++ b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst @@ -30,6 +30,7 @@ open FStar.Ident open FStar.Const open FStar.Errors open FStar.Syntax +open FStar.Class.Setlike module C = FStar.Parser.Const module S = FStar.Syntax.Syntax @@ -515,7 +516,7 @@ let rec destruct_app_pattern (env:env_t) (is_top_level:bool) (p:pattern) | _ -> failwith "Not an app pattern" -let rec gather_pattern_bound_vars_maybe_top acc p = +let rec gather_pattern_bound_vars_maybe_top (acc : FlatSet.t ident) p = let gather_pattern_bound_vars_from_list = List.fold_left gather_pattern_bound_vars_maybe_top acc in @@ -527,15 +528,15 @@ let rec gather_pattern_bound_vars_maybe_top acc p = | PatOp _ -> acc | PatApp (phead, pats) -> gather_pattern_bound_vars_from_list (phead::pats) | PatTvar (x, _, _) - | PatVar (x, _, _) -> Set.add x acc + | PatVar (x, _, _) -> add x acc | PatList pats | PatTuple (pats, _) | PatOr pats -> gather_pattern_bound_vars_from_list pats | PatRecord guarded_pats -> gather_pattern_bound_vars_from_list (List.map snd guarded_pats) | PatAscribed (pat, _) -> gather_pattern_bound_vars_maybe_top acc pat -let gather_pattern_bound_vars : pattern -> Set.set Ident.ident = - let acc = Set.empty () in +let gather_pattern_bound_vars : pattern -> FlatSet.t Ident.ident = + let acc = empty #ident () in fun p -> gather_pattern_bound_vars_maybe_top acc p type bnd = @@ -592,10 +593,10 @@ let rec generalize_annotated_univs (s:sigelt) :sigelt = list that we update as we find universes. We also keep a set of 'seen' universes, whose order we do not care, just for efficiency. *) let vars : ref (list univ_name) = mk_ref [] in - let seen : ref (Set.t univ_name) = mk_ref (Set.empty ()) in + let seen : ref (FlatSet.t univ_name) = mk_ref (empty ()) in let reg (u:univ_name) : unit = - if not (Set.mem u !seen) then ( - seen := Set.add u !seen; + if not (mem u !seen) then ( + seen := add u !seen; vars := u::!vars ) in @@ -663,11 +664,11 @@ let rec generalize_annotated_univs (s:sigelt) :sigelt = let generalize_annotated_univs_signature (s : effect_signature) : effect_signature = match s with | Layered_eff_sig (n, (_, t)) -> - let uvs = Free.univnames t |> Set.elems in + let uvs = Free.univnames t |> elems in let usubst = Subst.univ_var_closing uvs in Layered_eff_sig (n, (uvs, Subst.subst usubst t)) | WP_eff_sig (_, t) -> - let uvs = Free.univnames t |> Set.elems in + let uvs = Free.univnames t |> elems in let usubst = Subst.univ_var_closing uvs in WP_eff_sig (uvs, Subst.subst usubst t) in @@ -781,15 +782,15 @@ let check_linear_pattern_variables pats r = not wildcards. *) if string_of_id x.ppname = Ident.reserved_prefix then S.no_names - else Set.add x S.no_names + else add x S.no_names | Pat_cons(_, _, pats) -> let aux out (p, _) = let p_vars = pat_vars p in - let intersection = Set.inter p_vars out in - if Set.is_empty intersection - then Set.union out p_vars + let intersection = inter p_vars out in + if is_empty intersection + then union out p_vars else - let duplicate_bv = List.hd (Set.elems intersection) in + let duplicate_bv = List.hd (elems intersection) in raise_error ( Errors.Fatal_NonLinearPatternNotPermitted, BU.format1 "Non-linear patterns are not permitted: `%s` appears more than once in this pattern." @@ -807,10 +808,10 @@ let check_linear_pattern_variables pats r = | p::ps -> let pvars = pat_vars p in let aux p = - if Set.equal pvars (pat_vars p) then () else - let symdiff s1 s2 = Set.union (Set.diff s1 s2) (Set.diff s2 s1) in + if equal pvars (pat_vars p) then () else + let symdiff s1 s2 = union (diff s1 s2) (diff s2 s1) in let nonlinear_vars = symdiff pvars (pat_vars p) in - let first_nonlinear_var = List.hd (Set.elems nonlinear_vars) in + let first_nonlinear_var = List.hd (elems nonlinear_vars) in raise_error ( Errors.Fatal_IncoherentPatterns, BU.format1 "Patterns in this match are incoherent, variable %s is bound in some but not all patterns." @@ -1416,17 +1417,17 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an | Abs(binders, body) -> (* First of all, forbid definitions such as `f x x = ...` *) let bvss = List.map gather_pattern_bound_vars binders in - let check_disjoint (sets : list (Set.set ident)) : option ident = + let check_disjoint (sets : list (FlatSet.t ident)) : option ident = let rec aux acc sets = match sets with | [] -> None | set::sets -> - let i = Set.inter acc set in - if Set.is_empty i - then aux (Set.union acc set) sets - else Some (List.hd (Set.elems i)) + let i = inter acc set in + if is_empty i + then aux (union acc set) sets + else Some (List.hd (elems i)) in - aux (S.new_id_set ()) sets + aux (new_id_set ()) sets in begin match check_disjoint bvss with | None -> () @@ -1952,7 +1953,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let tm = SS.close vt_binders tm in // but we need to close the variables in tm let () = let fvs = Free.names tm in - if not (Set.is_empty fvs) then + if not (is_empty fvs) then raise_error (Errors.Fatal_MissingFieldInRecord, BU.format1 "Static quotation refers to external variables: %s" (Class.Show.show fvs)) (e.range) @@ -4021,7 +4022,7 @@ and desugar_decl_core env (d_attrs:list S.term) (d:decl) : (env_t * sigelts) = let build_projection (env, ses) id = build_generic_projection (env, ses) (Some id) in let build_coverage_check (env, ses) = build_generic_projection (env, ses) None in - let bvs = gather_pattern_bound_vars pat |> Set.elems in + let bvs = gather_pattern_bound_vars pat |> elems in (* If there are no variables in the pattern (and it is not a * wildcard), we should still check to see that it is complete, diff --git a/src/typechecker/FStar.TypeChecker.Core.fst b/src/typechecker/FStar.TypeChecker.Core.fst index 237e0494493..c353707ad82 100644 --- a/src/typechecker/FStar.TypeChecker.Core.fst +++ b/src/typechecker/FStar.TypeChecker.Core.fst @@ -17,6 +17,7 @@ module TcUtil = FStar.TypeChecker.Util module Hash = FStar.Syntax.Hash module Subst = FStar.Syntax.Subst open FStar.Class.Show +open FStar.Class.Setlike let goal_ctr = BU.mk_ref 0 let get_goal_ctr () = !goal_ctr @@ -604,7 +605,7 @@ let lookup (g:env) (e:term) : result (tot_or_ghost & typ) = let check_no_escape (bs:binders) t = let xs = FStar.Syntax.Free.names t in - if BU.for_all (fun b -> not (Set.mem b.binder_bv xs)) bs + if BU.for_all (fun b -> not (mem b.binder_bv xs)) bs then return () else fail "Name escapes its scope" @@ -1885,7 +1886,7 @@ let check_term_top_gh g e topt (must_tot:bool) (gh:option guard_handler_t) (BU.string_of_int (get_goal_ctr())) (P.term_to_string guard0) (P.term_to_string guard); - let guard_names = Syntax.Free.names guard |> Set.elems in + let guard_names = Syntax.Free.names guard |> elems in match List.tryFind (fun bv -> List.for_all (fun binding_env -> match binding_env with | Binding_var bv_env -> not (S.bv_eq bv_env bv) diff --git a/src/typechecker/FStar.TypeChecker.DMFF.fst b/src/typechecker/FStar.TypeChecker.DMFF.fst index ac6d797e8da..bd52925bf3c 100644 --- a/src/typechecker/FStar.TypeChecker.DMFF.fst +++ b/src/typechecker/FStar.TypeChecker.DMFF.fst @@ -41,6 +41,8 @@ module BU = FStar.Compiler.Util //basic util module U = FStar.Syntax.Util module PC = FStar.Parser.Const +open FStar.Class.Setlike + let d s = BU.print1 "\x1b[01;36m%s\x1b[00m\n" s // Takes care of creating the [fv], generating the top-level let-binding, and @@ -582,7 +584,7 @@ and star_type' env t = // (st a)* every time. let debug t s = let string_of_set f s = - let elts = Set.elems s in + let elts = elems s in match elts with | [] -> "{}" | x::xs -> @@ -606,14 +608,14 @@ and star_type' env t = else try let non_dependent_or_raise s ty = - let sinter = Set.inter (Free.names ty) s in - if not (Set.is_empty sinter) + let sinter = inter (Free.names ty) s in + if not (is_empty sinter) then (debug ty sinter ; raise Not_found) in let binders, c = SS.open_comp binders c in let s = List.fold_left (fun s ({binder_bv=bv}) -> non_dependent_or_raise s bv.sort ; - Set.add bv s + add bv s ) S.no_names binders in let ct = U.comp_result c in non_dependent_or_raise s ct ; @@ -1652,7 +1654,7 @@ let cps_and_elaborate (env:FStar.TypeChecker.Env.env) (ed:S.eff_decl) let wp_binders, c = SS.open_comp wp_binders c in let pre_args, post_args = List.partition (fun ({binder_bv=bv}) -> - Free.names bv.sort |> Set.mem type_param.binder_bv |> not + Free.names bv.sort |> mem type_param.binder_bv |> not ) wp_binders in let post = match post_args with diff --git a/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst b/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst index f25a796c536..e3b219b1655 100644 --- a/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst +++ b/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst @@ -36,6 +36,8 @@ module S = FStar.Syntax.Syntax module U = FStar.Syntax.Util module SS = FStar.Syntax.Subst +open FStar.Class.Setlike + let is_flex t = let head, _args = U.head_and_args_full t in match (SS.compress head).n with @@ -59,15 +61,15 @@ type goal_dep = goal_dep_id : int; // Assign each goal an id, for cycle detection goal_type : goal_type; // What sort of goal ... goal_imp : implicit; // The entire implicit from which this was generated - assignees : Set.t ctx_uvar; // The set of uvars assigned by the goal - goal_dep_uvars : Set.t ctx_uvar; // The set of uvars this goal depends on + assignees : FlatSet.t ctx_uvar; // The set of uvars assigned by the goal + goal_dep_uvars : FlatSet.t ctx_uvar; // The set of uvars this goal depends on dependences : ref goal_deps; // NB: mutable; the goals that must precede this one in the order visited : ref int // NB: mutable; a field to mark visited goals during the sort } and goal_deps = list goal_dep -let print_uvar_set (s:Set.t ctx_uvar) = - (Set.elems s +let print_uvar_set (s:FlatSet.t ctx_uvar) = + (elems s |> List.map (fun u -> "?" ^ (string_of_int <| Unionfind.uvar_id u.ctx_uvar_head)) |> String.concat "; ") diff --git a/src/typechecker/FStar.TypeChecker.Env.fst b/src/typechecker/FStar.TypeChecker.Env.fst index df352f4d2f6..a47eae5df9a 100644 --- a/src/typechecker/FStar.TypeChecker.Env.fst +++ b/src/typechecker/FStar.TypeChecker.Env.fst @@ -28,6 +28,7 @@ open FStar.Ident open FStar.Compiler.Range open FStar.Errors open FStar.TypeChecker.Common +open FStar.Class.Setlike open FStar.Class.Show open FStar.Class.PP @@ -1242,7 +1243,7 @@ let all_binders env = binders_of_bindings env.gamma let bound_vars env = bound_vars_of_bindings env.gamma instance hasBinders_env : hasBinders env = { - boundNames = (fun e -> Set.from_list (bound_vars e) ); + boundNames = (fun e -> FlatSet.from_list (bound_vars e) ); } instance hasNames_lcomp : hasNames lcomp = { @@ -1255,7 +1256,7 @@ instance pretty_lcomp : pretty lcomp = { instance hasNames_guard : hasNames guard_t = { freeNames = (fun g -> match g.guard_f with - | Trivial -> Set.empty () + | Trivial -> FlatSet.empty () | NonTrivial f -> freeNames f); } @@ -1747,34 +1748,31 @@ let finish_module = //////////////////////////////////////////////////////////// let uvars_in_env env = let no_uvs = Free.new_uv_set () in - let ext out uvs = Set.union out uvs in let rec aux out g = match g with | [] -> out | Binding_univ _ :: tl -> aux out tl | Binding_lid(_, (_, t))::tl - | Binding_var({sort=t})::tl -> aux (ext out (Free.uvars t)) tl + | Binding_var({sort=t})::tl -> aux (union out (Free.uvars t)) tl in aux no_uvs env.gamma let univ_vars env = let no_univs = Free.new_universe_uvar_set () in - let ext out uvs = Set.union out uvs in let rec aux out g = match g with | [] -> out | Binding_univ _ :: tl -> aux out tl | Binding_lid(_, (_, t))::tl - | Binding_var({sort=t})::tl -> aux (ext out (Free.univs t)) tl + | Binding_var({sort=t})::tl -> aux (union out (Free.univs t)) tl in aux no_univs env.gamma let univnames env = let no_univ_names = Syntax.no_universe_names in - let ext out uvs = Set.union out uvs in let rec aux out g = match g with | [] -> out - | Binding_univ uname :: tl -> aux (Set.add uname out) tl + | Binding_univ uname :: tl -> aux (add uname out) tl | Binding_lid(_, (_, t))::tl - | Binding_var({sort=t})::tl -> aux (ext out (Free.univnames t)) tl + | Binding_var({sort=t})::tl -> aux (union out (Free.univnames t)) tl in aux no_univ_names env.gamma @@ -1805,15 +1803,15 @@ let rem_proof_ns e path = cons_proof_ns false e path let get_proof_ns e = e.proof_ns let set_proof_ns ns e = {e with proof_ns = ns} -let unbound_vars (e : env) (t : term) : Set.t bv = +let unbound_vars (e : env) (t : term) : FlatSet.t bv = // FV(t) \ Vars(Γ) - List.fold_left (fun s bv -> Set.remove bv s) (Free.names t) (bound_vars e) + List.fold_left (fun s bv -> remove bv s) (Free.names t) (bound_vars e) let closed (e : env) (t : term) = - Set.is_empty (unbound_vars e t) + is_empty (unbound_vars e t) let closed' (t : term) = - Set.is_empty (Free.names t) + is_empty (Free.names t) let string_of_proof_ns env = let aux (p,b) = diff --git a/src/typechecker/FStar.TypeChecker.Env.fsti b/src/typechecker/FStar.TypeChecker.Env.fsti index 5c23de1131b..887ffc91ad7 100644 --- a/src/typechecker/FStar.TypeChecker.Env.fsti +++ b/src/typechecker/FStar.TypeChecker.Env.fsti @@ -405,8 +405,8 @@ val bound_vars : env -> list bv val all_binders : env -> binders val modules : env -> list modul val uvars_in_env : env -> uvars -val univ_vars : env -> Set.set universe_uvar -val univnames : env -> Set.set univ_name +val univ_vars : env -> FlatSet.t universe_uvar +val univnames : env -> FlatSet.t univ_name val lidents : env -> list lident (* operations on monads *) @@ -456,7 +456,7 @@ val set_proof_ns : proof_namespace -> env -> env val string_of_proof_ns : env -> string (* Check that all free variables of the term are defined in the environment *) -val unbound_vars : env -> term -> Set.set bv +val unbound_vars : env -> term -> FlatSet.t bv val closed : env -> term -> bool val closed' : term -> bool diff --git a/src/typechecker/FStar.TypeChecker.Generalize.fst b/src/typechecker/FStar.TypeChecker.Generalize.fst index 540bb1237fa..91ba89adae7 100644 --- a/src/typechecker/FStar.TypeChecker.Generalize.fst +++ b/src/typechecker/FStar.TypeChecker.Generalize.fst @@ -26,6 +26,7 @@ open FStar.Syntax.Syntax open FStar.TypeChecker.Env open FStar.Class.Show +open FStar.Class.Setlike module BU = FStar.Compiler.Util module S = FStar.Syntax.Syntax @@ -45,9 +46,9 @@ instance showable_univ_var : showable universe_uvar = { (* Generalizing types *) (**************************************************************************************) -let gen_univs env (x:Set.t universe_uvar) : list univ_name = - if Set.is_empty x then [] - else let s = Set.diff x (Env.univ_vars env) |> Set.elems in // GGG: bad, order dependent +let gen_univs env (x:FlatSet.t universe_uvar) : list univ_name = + if is_empty x then [] + else let s = diff x (Env.univ_vars env) |> elems in // GGG: bad, order dependent if Env.debug env <| Options.Other "Gen" then BU.print1 "univ_vars in env: %s\n" (show (Env.univ_vars env)); let r = Some (Env.get_range env) in @@ -63,10 +64,10 @@ let gen_univs env (x:Set.t universe_uvar) : list univ_name = in u_names -let gather_free_univnames env t : Set.t univ_name = +let gather_free_univnames env t : FlatSet.t univ_name = let ctx_univnames = Env.univnames env in let tm_univnames = Free.univnames t in - let univnames = Set.diff tm_univnames ctx_univnames in + let univnames = diff tm_univnames ctx_univnames in // BU.print4 "Closing universe variables in term %s : %s in ctx, %s in tm, %s globally\n" // (show t) // (Common.string_of_set Ident.string_of_id ctx_univnames) @@ -89,7 +90,7 @@ let check_universe_generalization let generalize_universes (env:env) (t0:term) : tscheme = Errors.with_ctx "While generalizing universes" (fun () -> let t = N.normalize [Env.NoFullNorm; Env.Beta; Env.DoNotUnfoldPureLets] env t0 in - let univnames = Set.elems (gather_free_univnames env t) in /// GGG: bad, order dependent + let univnames = elems (gather_free_univnames env t) in /// GGG: bad, order dependent if Env.debug env <| Options.Other "Gen" then BU.print2 "generalizing universes in the term (post norm): %s with univnames: %s\n" (show t) (show univnames); let univs = Free.univs t in @@ -116,7 +117,7 @@ let gen env (is_rec:bool) (lecs:list (lbname * term * comp)) : option (list (lbn BU.print1 "Normalized to:\n\t %s\n" (show c); c in let env_uvars = Env.uvars_in_env env in - let gen_uvars uvs = Set.diff uvs env_uvars |> Set.elems in /// GGG: bad, order depenedent + let gen_uvars uvs = diff uvs env_uvars |> elems in /// GGG: bad, order depenedent let univs_and_uvars_of_lec (lbname, e, c) = let c = norm c in let t = U.comp_result c in @@ -127,9 +128,9 @@ let gen env (is_rec:bool) (lecs:list (lbname * term * comp)) : option (list (lbn (show univs) (show uvt); let univs = List.fold_left - (fun univs uv -> Set.union univs (Free.univs (U.ctx_uvar_typ uv))) + (fun univs uv -> union univs (Free.univs (U.ctx_uvar_typ uv))) univs - (Set.elems uvt) // Bad; order dependent + (elems uvt) // Bad; order dependent in let uvs = gen_uvars uvt in if Env.debug env <| Options.Other "Gen" @@ -140,7 +141,7 @@ let gen env (is_rec:bool) (lecs:list (lbname * term * comp)) : option (list (lbn in let univs, uvs, lec_hd = univs_and_uvars_of_lec (List.hd lecs) in let force_univs_eq lec2 u1 u2 = - if Set.equal u1 u2 + if equal u1 u2 then () else let lb1, _, _ = lec_hd in let lb2, _, _ = lec2 in @@ -198,7 +199,7 @@ let gen env (is_rec:bool) (lecs:list (lbname * term * comp)) : option (list (lbn match (U.unrefine (N.unfold_whnf env kres)).n with | Tm_type _ -> let free = FStar.Syntax.Free.names kres in - if not (Set.is_empty free) then + if not (is_empty free) then [] else let a = S.new_bv (Some <| Env.get_range env) kres in @@ -265,14 +266,14 @@ let generalize' env (is_rec:bool) (lecs:list (lbname*term*comp)) : (list (lbname BU.print1 "Generalizing: %s\n" (show <| List.map (fun (lb, _, _) -> Print.lbname_to_string lb) lecs); let univnames_lecs = - let empty = Set.from_list [] in + let empty = from_list [] in List.fold_left (fun out (l, t, c) -> - Set.union out (gather_free_univnames env t)) + union out (gather_free_univnames env t)) empty lecs in - let univnames_lecs = Set.elems univnames_lecs in /// GGG: bad, order dependent + let univnames_lecs = elems univnames_lecs in /// GGG: bad, order dependent let generalized_lecs = match gen env is_rec lecs with | None -> lecs |> List.map (fun (l,t,c) -> l,[],t,c,[]) diff --git a/src/typechecker/FStar.TypeChecker.Positivity.fst b/src/typechecker/FStar.TypeChecker.Positivity.fst index f26fcaee9f5..5db4276ffee 100644 --- a/src/typechecker/FStar.TypeChecker.Positivity.fst +++ b/src/typechecker/FStar.TypeChecker.Positivity.fst @@ -33,6 +33,8 @@ module N = FStar.TypeChecker.Normalize module L = FStar.Compiler.List module C = FStar.Parser.Const +open FStar.Class.Setlike + (** This module implements the strict positivity check on inductive type @@ -184,7 +186,7 @@ let apply_constr_arrow (dlid:lident) (dt:term) (all_params:list arg) let ty_occurs_in (ty_lid:lident) (t:term) : bool - = Set.mem ty_lid (Free.fvars t) + = mem ty_lid (Free.fvars t) (* Checks if `t` is a name or fv and returns it, if so. *) let rec term_as_fv_or_name (t:term) diff --git a/src/typechecker/FStar.TypeChecker.Rel.fst b/src/typechecker/FStar.TypeChecker.Rel.fst index efe14da6f70..ed63152a3db 100644 --- a/src/typechecker/FStar.TypeChecker.Rel.fst +++ b/src/typechecker/FStar.TypeChecker.Rel.fst @@ -39,6 +39,7 @@ open FStar.Common open FStar.Class.Deq open FStar.Class.Show +open FStar.Class.Setlike module BU = FStar.Compiler.Util //basic util module U = FStar.Syntax.Util @@ -66,8 +67,8 @@ let is_base_type env typ = | Tm_type _ -> true | _ -> false -let binders_as_bv_set (bs:binders) = - Set.from_list (List.map (fun b -> b.binder_bv) bs) +let binders_as_bv_set (bs:binders) : FlatSet.t bv = + from_list (List.map (fun b -> b.binder_bv) bs) (* lazy string, for error reporting *) type lstring = Thunk.t string @@ -116,7 +117,7 @@ type worklist = { //is allowed; disabled by default, enabled in //sub_comp which is called by the typechecker, and //will insert the appropriate lifts. - typeclass_variables: Set.t ctx_uvar //variables that will be solved by typeclass instantiation + typeclass_variables: FlatSet.t ctx_uvar //variables that will be solved by typeclass instantiation } (* A NOTE ON ENVIRONMENTS @@ -290,7 +291,7 @@ let def_scope_wf msg rng r = in aux [] r instance hasBinders_prob : Class.Binders.hasBinders prob = { - boundNames = (fun prob -> Set.from_list (List.map (fun b -> b.binder_bv) <| p_scope prob)); + boundNames = (fun prob -> from_list (List.map (fun b -> b.binder_bv) <| p_scope prob)); } let def_check_term_scoped_in_prob msg prob phi = @@ -390,7 +391,7 @@ let empty_worklist env = { umax_heuristic_ok=true; wl_implicits=[]; repr_subcomp_allowed=false; - typeclass_variables = Set.empty(); + typeclass_variables = empty(); } let giveup wl (reason : lstring) prob = @@ -919,7 +920,7 @@ let ensure_no_uvar_subst env (t0:term) (wl:worklist) (Print.tag_of_term head) (Print.tag_of_term (SS.compress head))) -let no_free_uvars t = Set.is_empty (Free.uvars t) && Set.is_empty (Free.univs t) +let no_free_uvars t = is_empty (Free.uvars t) && is_empty (Free.univs t) (* Deciding when it's okay to issue an SMT query for * equating a term whose head symbol is `head` with another term @@ -1060,7 +1061,7 @@ let solve_prob (prob : prob) (logical_guard : option term) (uvis : list uvi) (wl let occurs (uk:ctx_uvar) t = let uvars = Free.uvars t - |> Set.elems // Bad: order dependent + |> elems // Bad: order dependent in let occurs = (uvars @@ -1079,7 +1080,7 @@ let occurs_check (uk:ctx_uvar) t = let occurs_full (uk:ctx_uvar) t = let uvars = Free.uvars_full t - |> Set.elems // Bad: order dependent + |> elems // Bad: order dependent in let occurs = (uvars @@ -1165,7 +1166,7 @@ let restrict_all_uvars env (tgt:ctx_uvar) (bs:binders) (sources:list ctx_uvar) w List.fold_right (fun (src:ctx_uvar) wl -> let ctx_src = binders_as_bv_set src.ctx_uvar_binders in - if Set.subset ctx_src ctx_tgt + if subset ctx_src ctx_tgt then wl // no need to restrict source, it's context is included in the context of the tgt else restrict_ctx env tgt [] src wl) sources @@ -1176,23 +1177,23 @@ let restrict_all_uvars env (tgt:ctx_uvar) (bs:binders) (sources:list ctx_uvar) w let intersect_binders (g:gamma) (v1:binders) (v2:binders) : binders = let as_set v = - v |> List.fold_left (fun out x -> Set.add x.binder_bv out) S.no_names in + v |> List.fold_left (fun out x -> add x.binder_bv out) S.no_names in let v1_set = as_set v1 in let ctx_binders = - List.fold_left (fun out b -> match b with Binding_var x -> Set.add x out | _ -> out) + List.fold_left (fun out b -> match b with Binding_var x -> add x out | _ -> out) S.no_names g in let isect, _ = v2 |> List.fold_left (fun (isect, isect_set) b -> let x, imp = b.binder_bv, b.binder_qual in - if not <| Set.mem x v1_set + if not <| mem x v1_set then //definitely not in the intersection isect, isect_set else //maybe in the intersect, if its type is only dependent on prior elements in the telescope let fvs = Free.names x.sort in - if Set.subset fvs isect_set - then b::isect, Set.add x isect_set + if subset fvs isect_set + then b::isect, add x isect_set else isect, isect_set) ([], ctx_binders) in List.rev isect @@ -2105,7 +2106,7 @@ let apply_ad_hoc_indexed_subcomp (env:Env.env) let has_typeclass_constraint (u:ctx_uvar) (wl:worklist) : bool - = wl.typeclass_variables |> Set.for_any (fun v -> UF.equiv v.ctx_uvar_head u.ctx_uvar_head) + = wl.typeclass_variables |> for_any (fun v -> UF.equiv v.ctx_uvar_head u.ctx_uvar_head) (* This function returns true for those lazykinds that are "complete" in the sense that unfolding them does not @@ -2128,7 +2129,7 @@ let lazy_complete_repr (k:lazy_kind) : bool = | _ -> false let has_free_uvars (t:term) : bool = - not (Set.is_empty (Free.uvars_uncached t)) + not (is_empty (Free.uvars_uncached t)) let env_has_free_uvars (e:env_t) : bool = List.existsb (fun b -> has_free_uvars b.binder_bv.sort) (Env.all_binders e) @@ -2846,7 +2847,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) let (Flex (_, ctx_u, args)) = lhs in let bs, rhs = let bv_not_free_in_arg x arg = - not (Set.mem x (Free.names (fst arg))) + not (mem x (Free.names (fst arg))) in let bv_not_free_in_args x args = BU.for_all (bv_not_free_in_arg x) args @@ -2954,7 +2955,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) then Inl ("quasi-pattern, occurs-check failed: " ^ (Option.get msg)), wl else let fvs_lhs = binders_as_bv_set (ctx_u.ctx_uvar_binders@bs) in let fvs_rhs = Free.names rhs in - if not (Set.subset fvs_rhs fvs_lhs) + if not (subset fvs_rhs fvs_lhs) then Inl ("quasi-pattern, free names on the RHS are not included in the LHS"), wl else Inr (mk_solution env lhs bs rhs), restrict_all_uvars env ctx_u [] uvars wl in @@ -3135,8 +3136,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) let uvars_head, occurs_ok, _ = occurs_check ctx_uv head in if not occurs_ok then inapplicable "occurs check failed" None - else if not (Set.subset (Free.names head) - (binders_as_bv_set ctx_uv.ctx_uvar_binders)) + else if not (Free.names head `subset` binders_as_bv_set ctx_uv.ctx_uvar_binders) then inapplicable "free name inclusion failed" None else ( let t_head, _ = @@ -3198,7 +3198,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) // will also try to restrict them // solve_sub_probs_if_head_types_equal - (head |> Free.uvars |> Set.elems) + (head |> Free.uvars |> elems) wl | Inr msg -> UF.rollback tx; @@ -3237,7 +3237,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) then giveup_or_defer orig wl Deferred_occur_check_failed (Thunk.mkv <| "occurs-check failed: " ^ (Option.get msg)) - else if Set.subset fvs2 fvs1 + else if subset fvs2 fvs1 then let sol = mk_solution env lhs lhs_binders rhs in let wl = restrict_all_uvars env ctx_uv lhs_binders uvars wl in solve (solve_prob orig None sol wl) @@ -4011,8 +4011,8 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = solve (attempt [base_prob] wl) in let has_uvars = - not (Set.is_empty (FStar.Syntax.Free.uvars phi1)) - || not (Set.is_empty (FStar.Syntax.Free.uvars phi2)) + not (is_empty (FStar.Syntax.Free.uvars phi1)) + || not (is_empty (FStar.Syntax.Free.uvars phi2)) in if problem.relation = EQ || (not env.uvar_subtyping && has_uvars) @@ -4954,10 +4954,10 @@ let try_solve_deferred_constraints (defer_ok:defer_ok_t) smt_ok deferred_to_tac_ then ( let goal_type = U.ctx_uvar_typ i.imp_uvar in let uvs = Free.uvars goal_type in - Set.elems uvs + elems uvs ) else [] - | _ -> []) |> Set.from_list + | _ -> []) |> from_list in let wl = {wl_of_guard env g.deferred with defer_ok=defer_ok ; smt_ok=smt_ok @@ -5437,7 +5437,7 @@ let pick_a_univ_deffered_implicit (out : tagged_implicits) let is_tac_implicit_resolved (env:env) (i:implicit) : bool = i.imp_tm |> Free.uvars - |> Set.for_all (fun uv -> Allow_unresolved? (U.ctx_uvar_should_check uv)) + |> for_all (fun uv -> Allow_unresolved? (U.ctx_uvar_should_check uv)) // is_tac: this is a call from within the tactic engine, hence do not use diff --git a/src/typechecker/FStar.TypeChecker.Tc.fst b/src/typechecker/FStar.TypeChecker.Tc.fst index f8770e9ec43..05848497571 100644 --- a/src/typechecker/FStar.TypeChecker.Tc.fst +++ b/src/typechecker/FStar.TypeChecker.Tc.fst @@ -32,7 +32,9 @@ open FStar.Syntax.Subst open FStar.Syntax.Util open FStar.Const open FStar.TypeChecker.TcTerm + open FStar.Class.Show +open FStar.Class.Setlike module S = FStar.Syntax.Syntax module SP = FStar.Syntax.Print @@ -505,7 +507,7 @@ let tc_sig_let env r se lbs lids : list sigelt * list sigelt * Env.env = then err ("no_subtype annotation on a non-lemma") lb.lbpos else let lid_opt = Free.fvars lb.lbtyp - |> Set.elems + |> elems |> List.tryFind (fun lid -> not (lid |> Ident.path_of_lid |> List.hd = "Prims" || lid_equals lid PC.pattern_lid)) in diff --git a/src/typechecker/FStar.TypeChecker.TcTerm.fst b/src/typechecker/FStar.TypeChecker.TcTerm.fst index 5e8885771ae..53f9584497e 100644 --- a/src/typechecker/FStar.TypeChecker.TcTerm.fst +++ b/src/typechecker/FStar.TypeChecker.TcTerm.fst @@ -36,6 +36,7 @@ open FStar.Compiler.Dyn open FStar.TypeChecker.Rel open FStar.Class.Show +open FStar.Class.Setlike module S = FStar.Syntax.Syntax module SS = FStar.Syntax.Subst @@ -93,7 +94,7 @@ let check_no_escape (head_opt : option term) let rec aux try_norm t = let t = if try_norm then norm env t else t in let fvs' = Free.names t in - match List.tryFind (fun x -> Set.mem x fvs') fvs with + match List.tryFind (fun x -> mem x fvs') fvs with | None -> t, Env.trivial_guard | Some x -> (* some variable x seems to escape, try normalizing if we haven't *) @@ -387,14 +388,14 @@ let print_expected_ty env = BU.print1 "%s\n" (print_expected_ty_str env) (* andlist: whether we're inside an SMTPatOr and we should take the * intersection of the sub-variables instead of the union. *) -let rec get_pat_vars' all (andlist : bool) (pats:term) : Set.t bv = +let rec get_pat_vars' all (andlist : bool) (pats:term) : FlatSet.t bv = let pats = unmeta pats in let head, args = head_and_args pats in match (un_uinst head).n, args with | Tm_fvar fv, _ when fv_eq_lid fv Const.nil_lid -> if andlist - then Set.from_list all - else Set.empty () + then from_list all + else empty () | Tm_fvar fv, [(_, Some ({ aqual_implicit = true })); (hd, None); (tl, None)] when fv_eq_lid fv Const.cons_lid -> (* The head is not under the scope of the SMTPatOr, consider @@ -404,8 +405,8 @@ let rec get_pat_vars' all (andlist : bool) (pats:term) : Set.t bv = let tlvs = get_pat_vars' all andlist tl in if andlist - then Set.inter hdvs tlvs - else Set.union hdvs tlvs + then inter hdvs tlvs + else union hdvs tlvs | Tm_fvar fv, [(_, Some ({ aqual_implicit = true })); (pat, None)] when fv_eq_lid fv Const.smtpat_lid -> Free.names pat @@ -413,13 +414,13 @@ let rec get_pat_vars' all (andlist : bool) (pats:term) : Set.t bv = | Tm_fvar fv, [(subpats, None)] when fv_eq_lid fv Const.smtpatOr_lid -> get_pat_vars' all true subpats - | _ -> Set.empty () + | _ -> empty () let get_pat_vars all pats = get_pat_vars' all false pats let check_pat_fvs rng env pats bs = let pat_vars = get_pat_vars (List.map (fun b -> b.binder_bv) bs) (N.normalize [Env.Beta] env pats) in - begin match bs |> BU.find_opt (fun ({binder_bv=b}) -> not(Set.mem b pat_vars)) with + begin match bs |> BU.find_opt (fun ({binder_bv=b}) -> not (mem b pat_vars)) with | None -> () | Some ({binder_bv=x}) -> Errors.log_issue rng @@ -4146,14 +4147,14 @@ and check_inner_let_rec env top = let cres = if cres.eff_name |> Env.norm_eff_name env |> Env.is_layered_effect env - then let bvss = Set.from_list bvs in + then let bvss = from_list bvs in TcComm.apply_lcomp (fun c -> if (c |> U.comp_effect_args |> List.existsb (fun (t, _) -> t |> Free.names - |> Set.inter bvss - |> Set.is_empty + |> inter bvss + |> is_empty |> not)) then raise_error (Errors.Fatal_EscapedBoundVar, "One of the inner let recs escapes in the \ diff --git a/src/typechecker/FStar.TypeChecker.Util.fst b/src/typechecker/FStar.TypeChecker.Util.fst index d9df1e66f41..29cc86c24f8 100644 --- a/src/typechecker/FStar.TypeChecker.Util.fst +++ b/src/typechecker/FStar.TypeChecker.Util.fst @@ -47,6 +47,8 @@ module P = FStar.Syntax.Print module C = FStar.Parser.Const module UF = FStar.Syntax.Unionfind +open FStar.Class.Setlike + //Reporting errors let report env errs = Errors.log_issue (Env.get_range env) @@ -80,7 +82,7 @@ let close_guard_implicits env solve_deferred (xs:binders) (g:guard_t) : guard_t let check_uvars r t = let uvs = Free.uvars t in - if not (Set.is_empty uvs) then begin + if not (is_empty uvs) then begin (* ignoring the hide_uvar_nums and print_implicits flags here *) Options.push(); Options.set_option "hide_uvar_nums" (Options.Bool false); @@ -2392,7 +2394,7 @@ let rec check_erased (env:Env.env) (t:term) : isErased = |> check_erased (br_body |> Free.names - |> Set.elems // GGG: bad, order-depending + |> elems // GGG: bad, order-depending |> Env.push_bvs env) with | No -> No | _ -> Maybe) No From b57266ef550d479fd3693bd074ef2331b59d3ab0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 21 Apr 2024 18:24:24 -0700 Subject: [PATCH 070/239] DeferredImplicits: Remove some dead code --- .../FStar.TypeChecker.DeferredImplicits.fst | 25 ------------------- 1 file changed, 25 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst b/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst index e3b219b1655..e3f04680c3b 100644 --- a/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst +++ b/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst @@ -56,31 +56,6 @@ type goal_type = | Can_be_split_into of term * term * ctx_uvar | Imp of ctx_uvar -type goal_dep = - { - goal_dep_id : int; // Assign each goal an id, for cycle detection - goal_type : goal_type; // What sort of goal ... - goal_imp : implicit; // The entire implicit from which this was generated - assignees : FlatSet.t ctx_uvar; // The set of uvars assigned by the goal - goal_dep_uvars : FlatSet.t ctx_uvar; // The set of uvars this goal depends on - dependences : ref goal_deps; // NB: mutable; the goals that must precede this one in the order - visited : ref int // NB: mutable; a field to mark visited goals during the sort - } -and goal_deps = list goal_dep - -let print_uvar_set (s:FlatSet.t ctx_uvar) = - (elems s - |> List.map (fun u -> "?" ^ (string_of_int <| Unionfind.uvar_id u.ctx_uvar_head)) - |> String.concat "; ") - -let print_goal_dep gd = - BU.format4 "%s:{assignees=[%s], dependences=[%s]}\n\t%s\n" - (BU.string_of_int gd.goal_dep_id) - (print_uvar_set gd.assignees) - (List.map (fun gd -> string_of_int gd.goal_dep_id) (!gd.dependences) - |> String.concat "; ") - (Print.ctx_uvar_to_string gd.goal_imp.imp_uvar) - (* If [u] is tagged with attribute [a] From 9653efae48b6f28b31b299dc15563ac9da691fc0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 21 Apr 2024 17:05:27 -0700 Subject: [PATCH 071/239] data: add RBSet --- src/class/FStar.Class.Setlike.fsti | 9 +- src/data/FStar.Compiler.RBSet.fst | 166 +++++++++++++++++++++++++++++ src/data/FStar.Compiler.RBSet.fsti | 32 ++++++ 3 files changed, 203 insertions(+), 4 deletions(-) create mode 100644 src/data/FStar.Compiler.RBSet.fst create mode 100644 src/data/FStar.Compiler.RBSet.fsti diff --git a/src/class/FStar.Class.Setlike.fsti b/src/class/FStar.Class.Setlike.fsti index 28536a5e06e..edfa7d4b8e2 100644 --- a/src/class/FStar.Class.Setlike.fsti +++ b/src/class/FStar.Class.Setlike.fsti @@ -8,10 +8,7 @@ class setlike (e:Type) (s:Type) = { empty : unit -> s; singleton : e -> s; is_empty : s -> bool; - from_list : list e -> s; - elems : s -> list e; add : e -> s -> s; - addn : list e -> s -> s; remove : e -> s -> s; mem : e -> s -> bool; equal : s -> s -> bool; @@ -19,9 +16,13 @@ class setlike (e:Type) (s:Type) = { union : s -> s -> s; inter : s -> s -> s; diff : s -> s -> s; - collect : (e -> s) -> list e -> s; for_all : (e -> bool) -> s -> bool; for_any : (e -> bool) -> s -> bool; + elems : s -> list e; + + collect : (e -> s) -> list e -> s; + from_list : list e -> s; + addn : list e -> s -> s; } val symdiff (#e #s : Type) {| setlike e s |} : s -> s -> s diff --git a/src/data/FStar.Compiler.RBSet.fst b/src/data/FStar.Compiler.RBSet.fst new file mode 100644 index 00000000000..50d53607fd7 --- /dev/null +++ b/src/data/FStar.Compiler.RBSet.fst @@ -0,0 +1,166 @@ +(* + Copyright 2008-2017 Microsoft Research + + Authors: Aseem Rastogi, Nikhil Swamy, Jonathan Protzenko + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + +module FStar.Compiler.RBSet + +open FStar.Class.Ord +open FStar.Class.Show +open FStar.Class.Setlike + +include FStar.Class.Setlike + +type color = | R | B + +type rbset (a:Type0) : Type0 = + | L + | N of color * rbset a * a * rbset a + +let empty () = L + +let singleton (x:'a) : rbset 'a = N (R, L, x, L) + +let is_empty = L? + +let balance c l x r = + match c, l, x, r with + | B, N (R, N (R, a, x, b), y, c), z, d + | B, a, x, N (R, N (R, b, y, c), z, d) + | B, N (R, a, x, N (R, b, y, c)), z, d + | B, a, x, N (R, b, y, N (R, c, z, d)) -> + N (R, N (B, a, x, b), y, N (B, c, z, d)) + | c, l, x, r -> N (c, l, x, r) + +let blackroot (t:rbset 'a{N? t}) : rbset 'a = + match t with + | N (_, l, x, r) -> N (B, l, x, r) + +let add {| ord 'a |} (x:'a) (s:rbset 'a) : rbset 'a = + let rec add' (s:rbset 'a) : rbset 'a = + match s with + | L -> N (R, L, x, L) + | N (c, a, y, b) -> + if x ? y then balance c a y (add' b) + else s + in + blackroot (add' s) + +let rec extract_min #a {| ord a |} (t : rbset a{N? t}) : rbset a & a = + match t with + | N (_, L, x, L) -> L, x + | N (c, N (_, L, x, L), y, L) -> N (B, L, x, L), y + | N (c, a, x, b) -> + let (a', y) = extract_min a in + balance c a' x b, y + +(* This is not the right way, see https://www.cs.cornell.edu/courses/cs3110/2020sp/a4/deletion.pdf +for how to do it. But if we reach that complexity, I would like for +this whole module to be verified. *) +let rec remove {| ord 'a |} (x:'a) (t:rbset 'a) : rbset 'a = + match t with + | L -> L + | N (c, l, y, r) -> + if x ? y then balance c l y (remove x r) + else + let (r', y') = extract_min r in + balance c l y' r' + +let rec mem {| ord 'a |} (x:'a) (s:rbset 'a) : bool = + match s with + | L -> false + | N (_, a, y, b) -> + if x ? y then mem x b + else true + +let rec elems (s:rbset 'a) : list 'a = + match s with + | L -> [] + | N (_, a, x, b) -> elems a @ [x] @ elems b + +let equal {| ord 'a |} (s1:rbset 'a) (s2:rbset 'a) : bool = + elems s1 =? elems s2 + +let rec union {| ord 'a |} (s1:rbset 'a) (s2:rbset 'a) : rbset 'a = + match s1 with + | L -> s2 + | N (c, a, x, b) -> union a (union b (add x s2)) + +let inter {| ord 'a |} (s1:rbset 'a) (s2:rbset 'a) : rbset 'a = + let rec aux (s1:rbset 'a) (acc : rbset 'a) : rbset 'a = + match s1 with + | L -> acc + | N (_, a, x, b) -> + if mem x s2 + then add x (aux a (aux b acc)) + else aux a (aux b acc) + in + aux s1 L + +let rec diff {| ord 'a |} (s1:rbset 'a) (s2:rbset 'a) : rbset 'a = + match s2 with + | L -> s1 + | N (_, a, x, b) -> diff (diff (remove x s1) a) b + +let rec subset {| ord 'a |} (s1:rbset 'a) (s2:rbset 'a) : bool = + match s1 with + | L -> true + | N (_, a, x, b) -> mem x s2 && subset a s2 && subset b s2 + +let rec for_all (p:'a -> bool) (s:rbset 'a) : bool = + match s with + | L -> true + | N (_, a, x, b) -> p x && for_all p a && for_all p b + +let rec for_any (p:'a -> bool) (s:rbset 'a) : bool = + match s with + | L -> false + | N (_, a, x, b) -> p x || for_any p a || for_any p b + +// Make this faster +let from_list {| ord 'a |} (xs : list 'a) : rbset 'a = + List.fold_left (fun s e -> add e s) L xs + +let addn {| ord 'a |} (xs : list 'a) (s : rbset 'a) : rbset 'a = + List.fold_left (fun s e -> add e s) s xs + +let collect #a {| ord a |} (f : a -> rbset a) + (l : list a) : rbset a = + List.fold_left (fun s e -> union (f e) s) L l + +instance setlike_rbset (a:Type) (_ : ord a) : Tot (setlike a (rbset a)) = { + empty = empty; + singleton = singleton; + is_empty = is_empty; + add = add; + remove = remove; + mem = mem; + equal = equal; + subset = subset; + union = union; + inter = inter; + diff = diff; + for_all = for_all; + for_any = for_any; + elems = elems; + + collect = collect; + from_list = from_list; + addn = addn; +} diff --git a/src/data/FStar.Compiler.RBSet.fsti b/src/data/FStar.Compiler.RBSet.fsti new file mode 100644 index 00000000000..0334ba6b958 --- /dev/null +++ b/src/data/FStar.Compiler.RBSet.fsti @@ -0,0 +1,32 @@ +(* + Copyright 2008-2017 Microsoft Research + + Authors: Aseem Rastogi, Nikhil Swamy, Jonathan Protzenko + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + +module FStar.Compiler.RBSet + +open FStar.Class.Ord +open FStar.Class.Show +open FStar.Class.Setlike +include FStar.Class.Setlike + +new +val rbset (a:Type0) : Type0 + +type t = rbset + +instance +val setlike_rbset (a:Type0) (_ : ord a) : Tot (setlike a (t a)) From 488dfdce2767894731c47a374afeb7367fb711fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 22 Apr 2024 18:37:19 -0700 Subject: [PATCH 072/239] rbset --- src/data/FStar.Compiler.RBSet.fst | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/data/FStar.Compiler.RBSet.fst b/src/data/FStar.Compiler.RBSet.fst index 50d53607fd7..fd66fa9c78c 100644 --- a/src/data/FStar.Compiler.RBSet.fst +++ b/src/data/FStar.Compiler.RBSet.fst @@ -78,8 +78,12 @@ let rec remove {| ord 'a |} (x:'a) (t:rbset 'a) : rbset 'a = if x ? y then balance c l y (remove x r) else - let (r', y') = extract_min r in - balance c l y' r' + if L? r + then + l + else + let (r', y') = extract_min r in + balance c l y' r' let rec mem {| ord 'a |} (x:'a) (s:rbset 'a) : bool = match s with From 6dc5e6b30347306703efaf1618a0af459cd96546 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 21 Apr 2024 17:07:10 -0700 Subject: [PATCH 073/239] Use RBSet in some places --- .../FStar.Extraction.ML.RemoveUnusedParameters.fst | 4 ++-- src/fstar/FStar.Interactive.Ide.fst | 2 +- src/smtencoding/FStar.SMTEncoding.Term.fst | 5 +---- src/syntax/FStar.Syntax.DsEnv.fst | 4 ++-- src/typechecker/FStar.TypeChecker.Rel.fst | 2 +- 5 files changed, 7 insertions(+), 10 deletions(-) diff --git a/src/extraction/FStar.Extraction.ML.RemoveUnusedParameters.fst b/src/extraction/FStar.Extraction.ML.RemoveUnusedParameters.fst index 828993a1273..bf761800536 100644 --- a/src/extraction/FStar.Extraction.ML.RemoveUnusedParameters.fst +++ b/src/extraction/FStar.Extraction.ML.RemoveUnusedParameters.fst @@ -76,8 +76,8 @@ let lookup_tyname (env:env_t) (name:mlpath) = BU.psmap_try_find env.tydef_map (string_of_mlpath name) (** Free variables of a type: Computed to check which parameters are used *) -type var_set = FlatSet.t mlident -let empty_var_set : FlatSet.t string = empty () +type var_set = RBSet.t mlident +let empty_var_set : RBSet.t string = empty () let rec freevars_of_mlty' (vars:var_set) (t:mlty) = match t with | MLTY_Var i -> diff --git a/src/fstar/FStar.Interactive.Ide.fst b/src/fstar/FStar.Interactive.Ide.fst index 74ef6e21ba3..949f76b1fc3 100644 --- a/src/fstar/FStar.Interactive.Ide.fst +++ b/src/fstar/FStar.Interactive.Ide.fst @@ -968,7 +968,7 @@ let st_cost = function type search_candidate = { sc_lid: lid; sc_typ: ref (option Syntax.Syntax.typ); - sc_fvars: ref (option (FlatSet.t lid)) } + sc_fvars: ref (option (RBSet.t lid)) } let sc_of_lid lid = { sc_lid = lid; sc_typ = Util.mk_ref None; diff --git a/src/smtencoding/FStar.SMTEncoding.Term.fst b/src/smtencoding/FStar.SMTEncoding.Term.fst index b321f9e4c6b..5858d4981d7 100644 --- a/src/smtencoding/FStar.SMTEncoding.Term.fst +++ b/src/smtencoding/FStar.SMTEncoding.Term.fst @@ -146,10 +146,7 @@ let fv_force (x:fv) = let FV (_, _, force) = x in force let fv_eq (x:fv) (y:fv) = fv_name x = fv_name y let fvs_subset_of (x:fvs) (y:fvs) = let open FStar.Class.Setlike in - let cmp_fv x y = - BU.compare (fv_name x) (fv_name y) - in - subset (from_list x <: FlatSet.t fv) (from_list y) + subset (from_list x <: RBSet.t fv) (from_list y) let freevar_eq x y = match x.tm, y.tm with | FreeV x, FreeV y -> fv_eq x y diff --git a/src/syntax/FStar.Syntax.DsEnv.fst b/src/syntax/FStar.Syntax.DsEnv.fst index a62d068c3c5..9de5e754494 100644 --- a/src/syntax/FStar.Syntax.DsEnv.fst +++ b/src/syntax/FStar.Syntax.DsEnv.fst @@ -51,7 +51,7 @@ type scope_mod = | Top_level_def of ident (* top-level definition for an unqualified identifier x to be resolved as curmodule.x. *) | Record_or_dc of record_or_dc (* to honor interleavings of "open" and record definitions *) -type string_set = FlatSet.t string +type string_set = RBSet.t string type exported_id_kind = (* kinds of identifiers exported by a module *) | Exported_id_term_type (* term and type identifiers *) @@ -958,7 +958,7 @@ let try_lookup_dc_by_field_name env (fieldname:lident) = | Some r -> Some (set_lid_range (lid_of_ids (ns_of_lid r.typename @ [r.constrname])) (range_of_lid fieldname), r.is_record) | _ -> None -let string_set_ref_new () : ref (FlatSet.t string) = BU.mk_ref (empty ()) +let string_set_ref_new () : ref string_set = BU.mk_ref (empty ()) let exported_id_set_new () = let term_type_set = string_set_ref_new () in let field_set = string_set_ref_new () in diff --git a/src/typechecker/FStar.TypeChecker.Rel.fst b/src/typechecker/FStar.TypeChecker.Rel.fst index ed63152a3db..e15ec77e6c3 100644 --- a/src/typechecker/FStar.TypeChecker.Rel.fst +++ b/src/typechecker/FStar.TypeChecker.Rel.fst @@ -117,7 +117,7 @@ type worklist = { //is allowed; disabled by default, enabled in //sub_comp which is called by the typechecker, and //will insert the appropriate lifts. - typeclass_variables: FlatSet.t ctx_uvar //variables that will be solved by typeclass instantiation + typeclass_variables: RBSet.t ctx_uvar //variables that will be solved by typeclass instantiation } (* A NOTE ON ENVIRONMENTS From 0605d74b6584d41dce955b2cfe704aaaf4f0f278 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 21 Apr 2024 18:57:30 -0700 Subject: [PATCH 074/239] DsEnv: remove some set<->list transformations --- src/syntax/FStar.Syntax.DsEnv.fst | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/syntax/FStar.Syntax.DsEnv.fst b/src/syntax/FStar.Syntax.DsEnv.fst index 9de5e754494..6635464f5b7 100644 --- a/src/syntax/FStar.Syntax.DsEnv.fst +++ b/src/syntax/FStar.Syntax.DsEnv.fst @@ -1257,12 +1257,12 @@ let finish_module_or_interface env modul = finish env modul, modul type exported_ids = { - exported_id_terms:list string; - exported_id_fields:list string + exported_id_terms : string_set; + exported_id_fields: string_set; } let as_exported_ids (e:exported_id_set) = - let terms = elems (!(e Exported_id_term_type)) in - let fields = elems (!(e Exported_id_field)) in + let terms = (!(e Exported_id_term_type)) in + let fields = (!(e Exported_id_field)) in {exported_id_terms=terms; exported_id_fields=fields} @@ -1271,9 +1271,9 @@ let as_exported_id_set (e:option exported_ids) = | None -> exported_id_set_new () | Some e -> let terms = - BU.mk_ref (from_list e.exported_id_terms) in + BU.mk_ref (e.exported_id_terms) in let fields = - BU.mk_ref (from_list e.exported_id_fields) in + BU.mk_ref (e.exported_id_fields) in function | Exported_id_term_type -> terms | Exported_id_field -> fields From 9e4d89e4fa6e64042800aa77235e5557c26af9a4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 22 Apr 2024 17:12:16 -0700 Subject: [PATCH 075/239] tests.exe: add a module for data structure testing/benchmark --- src/tests/FStar.Tests.Data.fst | 54 ++++++++++++++++++++++++++++++++++ src/tests/FStar.Tests.Test.fst | 1 + 2 files changed, 55 insertions(+) create mode 100644 src/tests/FStar.Tests.Data.fst diff --git a/src/tests/FStar.Tests.Data.fst b/src/tests/FStar.Tests.Data.fst new file mode 100644 index 00000000000..27ee0e674c0 --- /dev/null +++ b/src/tests/FStar.Tests.Data.fst @@ -0,0 +1,54 @@ +(* + Copyright 2008-2014 Nikhil Swamy and Microsoft Research + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) +module FStar.Tests.Data +// tests about data structures + + +open FStar +open FStar.Compiler +open FStar.Compiler.Effect +module BU = FStar.Compiler.Util + +module FlatSet = FStar.Compiler.FlatSet +module RBSet = FStar.Compiler.RBSet + +open FStar.Class.Setlike +open FStar.Class.Show + +let rec insert (n:int) {| setlike int 'set |} (s : 'set) = + if n = 0 then s + else insert (n-1) (add n s) + +let rec all_mem (n:int) {| setlike int 'set |} (s : 'set) = + if n = 0 then true + else mem n s && all_mem (n-1) s + +let nn = 50000 + +let run_all () = + BU.print_string "data tests\n"; + let (f, ms) = BU.record_time (fun () -> insert nn (empty () <: FlatSet.t int)) in + BU.print1 "FlatSet insert: %s\n" (show ms); + let (f_ok, ms) = BU.record_time (fun () -> all_mem nn f) in + BU.print1 "FlatSet all_mem: %s\n" (show ms); + if not f_ok then failwith "FlatSet all_mem failed"; + + let (rb, ms) = BU.record_time (fun () -> insert nn (empty () <: RBSet.t int)) in + BU.print1 "RBSet insert: %s\n" (show ms); + let (rb_ok, ms) = BU.record_time (fun () -> all_mem nn rb) in + BU.print1 "RBSet all_mem: %s\n" (show ms); + if not rb_ok then failwith "RBSet all_mem failed"; + () diff --git a/src/tests/FStar.Tests.Test.fst b/src/tests/FStar.Tests.Test.fst index fb6c18a065e..0a6317fd476 100644 --- a/src/tests/FStar.Tests.Test.fst +++ b/src/tests/FStar.Tests.Test.fst @@ -42,6 +42,7 @@ let main argv = Pars.parse_incremental_decls(); Norm.run_all (); if Unif.run_all () then () else exit 1; + Data.run_all (); exit 0 with | Error(err, msg, r, _ctx) when not <| O.trace_error() -> From 3e32b5064e70e803cc38d80c652d43eff8837c90 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 22 Apr 2024 17:52:07 -0700 Subject: [PATCH 076/239] CheckedFiles: Remove some needless includes --- src/fstar/FStar.CheckedFiles.fst | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/src/fstar/FStar.CheckedFiles.fst b/src/fstar/FStar.CheckedFiles.fst index fd7da3807fc..c914320b36e 100644 --- a/src/fstar/FStar.CheckedFiles.fst +++ b/src/fstar/FStar.CheckedFiles.fst @@ -16,15 +16,10 @@ module FStar.CheckedFiles open FStar -open FStar.Pervasives -open FStar.Compiler.Effect open FStar.Compiler -open FStar.Errors +open FStar.Compiler.Effect open FStar.Compiler.Util -open FStar.Getopt -open FStar.Syntax.Syntax -open FStar.TypeChecker.Env -open FStar.Syntax.DsEnv + open FStar.Class.Show (* Module abbreviations for the universal type-checker *) From 2496522427e970805f8f179eb59fa63aa87b92cd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 22 Apr 2024 17:52:28 -0700 Subject: [PATCH 077/239] Bump checked file version (module_inclusion_info now has different type) --- src/fstar/FStar.CheckedFiles.fst | 3 +-- ulib/prims.fst | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/src/fstar/FStar.CheckedFiles.fst b/src/fstar/FStar.CheckedFiles.fst index c914320b36e..f629b8e123d 100644 --- a/src/fstar/FStar.CheckedFiles.fst +++ b/src/fstar/FStar.CheckedFiles.fst @@ -29,13 +29,12 @@ module SMT = FStar.SMTEncoding.Solver module BU = FStar.Compiler.Util module Dep = FStar.Parser.Dep - (* * We write this version number to the cache files, and * detect when loading the cache that the version number is same * It needs to be kept in sync with prims.fst *) -let cache_version_number = 65 +let cache_version_number = 66 (* * Abbreviation for what we store in the checked files (stages as described below) diff --git a/ulib/prims.fst b/ulib/prims.fst index 7aea931e543..395ff6206c5 100644 --- a/ulib/prims.fst +++ b/ulib/prims.fst @@ -708,4 +708,4 @@ val string_of_int: int -> Tot string (** THIS IS MEANT TO BE KEPT IN SYNC WITH FStar.CheckedFiles.fs Incrementing this forces all .checked files to be invalidated *) irreducible -let __cache_version_number__ = 65 +let __cache_version_number__ = 66 From 9cc3efb7f089e013dc6c187cf5f410b8c10f97c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 22 Apr 2024 18:09:07 -0700 Subject: [PATCH 078/239] Syntax.Free: use an RBSet for the fvars --- src/syntax/FStar.Syntax.Free.fst | 10 ++++++---- src/syntax/FStar.Syntax.Free.fsti | 2 +- src/syntax/FStar.Syntax.Syntax.fst | 2 +- src/syntax/FStar.Syntax.Syntax.fsti | 4 ++-- src/tosyntax/FStar.ToSyntax.ToSyntax.fst | 2 +- 5 files changed, 11 insertions(+), 9 deletions(-) diff --git a/src/syntax/FStar.Syntax.Free.fst b/src/syntax/FStar.Syntax.Free.fst index b277c98c6d8..36abd4c63e2 100644 --- a/src/syntax/FStar.Syntax.Free.fst +++ b/src/syntax/FStar.Syntax.Free.fst @@ -22,7 +22,6 @@ open FStar.Compiler.List open FStar open FStar.Compiler open FStar.Compiler.Util -open FStar.Compiler.FlatSet open FStar.Syntax open FStar.Syntax.Syntax module Util = FStar.Compiler.Util @@ -30,6 +29,7 @@ module UF = FStar.Syntax.Unionfind open FStar.Class.Ord open FStar.Class.Show +open FStar.Class.Setlike let compare_uv uv1 uv2 = UF.uvar_id uv1.ctx_uvar_head - UF.uvar_id uv2.ctx_uvar_head let compare_universe_uvar x y = UF.univ_uvar_id x - UF.univ_uvar_id y @@ -62,7 +62,9 @@ type use_cache_t = | NoCache | Full -type free_vars_and_fvars = free_vars * flat_set Ident.lident +(* We use an RBSet for the fvars, as order definitely does not matter here +and it's faster. *) +type free_vars_and_fvars = free_vars * RBSet.t Ident.lident (* Snoc without duplicates *) val snoc : #a:Type -> {| deq a |} -> list a -> a -> list a @@ -98,7 +100,7 @@ let union (f1 : free_vars_and_fvars) (f2 : free_vars_and_fvars) = { free_univs=(fst f1).free_univs @@ (fst f2).free_univs; free_univ_names=(fst f1).free_univ_names @@ (fst f2).free_univ_names; //THE ORDER HERE IS IMPORTANT! //We expect the free_univ_names list to be in fifo order to get the right order of universe generalization -}, union #Ident.lident (snd f1) (snd f2) +}, union (snd f1) (snd f2) let rec free_univs u = match Subst.compress_univ u with | U_zero @@ -240,7 +242,7 @@ and free_names_and_uvars t use_cache = if use_cache <> Full then t.vars := Some (fst n); n -and free_names_and_uvars_args args (acc:free_vars * flat_set Ident.lident) use_cache = +and free_names_and_uvars_args args (acc : free_vars_and_fvars) use_cache = args |> List.fold_left (fun n (x, _) -> union n (free_names_and_uvars x use_cache)) acc and free_names_and_uvars_comp c use_cache = diff --git a/src/syntax/FStar.Syntax.Free.fsti b/src/syntax/FStar.Syntax.Free.fsti index 7cdc93c49fc..bc503bcf33e 100644 --- a/src/syntax/FStar.Syntax.Free.fsti +++ b/src/syntax/FStar.Syntax.Free.fsti @@ -32,7 +32,7 @@ val uvars: term -> flat_set ctx_uvar val univs: term -> flat_set universe_uvar val univnames: term -> flat_set univ_name val univnames_comp: comp -> flat_set univ_name -val fvars: term -> flat_set Ident.lident +val fvars: term -> RBSet.t Ident.lident val names_of_binders: binders -> flat_set bv val uvars_uncached: term -> flat_set ctx_uvar diff --git a/src/syntax/FStar.Syntax.Syntax.fst b/src/syntax/FStar.Syntax.Syntax.fst index e24a356bd84..eeee44edd65 100644 --- a/src/syntax/FStar.Syntax.Syntax.fst +++ b/src/syntax/FStar.Syntax.Syntax.fst @@ -162,7 +162,7 @@ let mk_fvs () = Util.mk_ref None let mk_uvs () = Util.mk_ref None let new_bv_set () : FlatSet.t bv = empty () let new_id_set () : FlatSet.t ident = empty () -let new_fv_set () : FlatSet.t lident = empty () +let new_fv_set () : RBSet.t lident = empty () let new_universe_names_set () : FlatSet.t univ_name = empty () let no_names = new_bv_set() diff --git a/src/syntax/FStar.Syntax.Syntax.fsti b/src/syntax/FStar.Syntax.Syntax.fsti index 78d8bdc9299..38f7cc3bad2 100644 --- a/src/syntax/FStar.Syntax.Syntax.fsti +++ b/src/syntax/FStar.Syntax.Syntax.fsti @@ -753,7 +753,7 @@ val lookup_aq : bv -> antiquotations -> term val lazy_chooser : ref (option (lazy_kind -> lazyinfo -> term)) val new_bv_set: unit -> FlatSet.t bv val new_id_set: unit -> FlatSet.t ident -val new_fv_set: unit -> FlatSet.t lident +val new_fv_set: unit -> RBSet.t lident val new_universe_names_set: unit -> FlatSet.t univ_name val mod_name: modul -> lident @@ -806,7 +806,7 @@ val is_type: term -> bool val no_names: freenames val no_universe_names: FlatSet.t univ_name -val no_fvars: FlatSet.t lident +val no_fvars: RBSet.t lident val freenames_of_list: list bv -> freenames val freenames_of_binders: binders -> freenames diff --git a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst index 6a2203c8230..554275f7137 100644 --- a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst +++ b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst @@ -593,7 +593,7 @@ let rec generalize_annotated_univs (s:sigelt) :sigelt = list that we update as we find universes. We also keep a set of 'seen' universes, whose order we do not care, just for efficiency. *) let vars : ref (list univ_name) = mk_ref [] in - let seen : ref (FlatSet.t univ_name) = mk_ref (empty ()) in + let seen : ref (RBSet.t univ_name) = mk_ref (empty ()) in let reg (u:univ_name) : unit = if not (mem u !seen) then ( seen := add u !seen; From da66629e88411811c3f004a3585cdf53aa88f9dc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Tue, 23 Apr 2024 20:12:53 -0700 Subject: [PATCH 079/239] Format an error --- src/tosyntax/FStar.ToSyntax.ToSyntax.fst | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst index 554275f7137..9e257556543 100644 --- a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst +++ b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst @@ -1432,10 +1432,12 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an begin match check_disjoint bvss with | None -> () | Some id -> - raise_error (Errors.Fatal_NonLinearPatternNotPermitted, - BU.format1 - "Non-linear patterns are not permitted: `%s` appears more than once in this function definition." (string_of_id id)) - (range_of_id id) + let open FStar.Pprint in + let open FStar.Class.PP in + raise_error_doc (Errors.Fatal_NonLinearPatternNotPermitted, [ + text "Non-linear patterns are not permitted."; + text "The variable " ^/^ squotes (pp id) ^/^ text " appears more than once in this function definition." + ]) (range_of_id id) end; let binders = binders |> List.map replace_unit_pattern in From 447da35c86f02da200d45103f82cf867db1c27fb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Tue, 23 Apr 2024 20:24:58 -0700 Subject: [PATCH 080/239] Remove specialized empty set constructors, just use empty() --- src/fstar/FStar.Interactive.Ide.fst | 1 - src/syntax/FStar.Syntax.Free.fst | 15 ++++++--------- src/syntax/FStar.Syntax.Free.fsti | 20 ++++++++------------ src/syntax/FStar.Syntax.Print.Pretty.fst | 2 +- src/syntax/FStar.Syntax.Syntax.fst | 12 ++---------- src/syntax/FStar.Syntax.Syntax.fsti | 10 ---------- src/tactics/FStar.Tactics.V1.Basic.fst | 4 ++-- src/tactics/FStar.Tactics.V2.Basic.fst | 4 ++-- src/tosyntax/FStar.ToSyntax.ToSyntax.fst | 13 +++++++------ src/typechecker/FStar.TypeChecker.DMFF.fst | 2 +- src/typechecker/FStar.TypeChecker.Env.fst | 6 +++--- src/typechecker/FStar.TypeChecker.Rel.fst | 7 ++++--- 12 files changed, 36 insertions(+), 60 deletions(-) diff --git a/src/fstar/FStar.Interactive.Ide.fst b/src/fstar/FStar.Interactive.Ide.fst index 949f76b1fc3..92a13931631 100644 --- a/src/fstar/FStar.Interactive.Ide.fst +++ b/src/fstar/FStar.Interactive.Ide.fst @@ -997,7 +997,6 @@ exception InvalidSearch of string let run_search st search_str = let tcenv = st.repl_env in - let empty_fv_set = SS.new_fv_set () in let st_matches candidate term = let found = diff --git a/src/syntax/FStar.Syntax.Free.fst b/src/syntax/FStar.Syntax.Free.fst index 36abd4c63e2..226878affaf 100644 --- a/src/syntax/FStar.Syntax.Free.fst +++ b/src/syntax/FStar.Syntax.Free.fst @@ -78,16 +78,16 @@ let rec snoc xx y = val (@@) : #a:Type -> {| deq a |} -> list a -> list a -> list a let (@@) xs ys = List.fold_left (fun xs y -> snoc xs y) xs ys -let no_free_vars = { +let no_free_vars : free_vars_and_fvars = { free_names=[]; free_uvars=[]; free_univs=[]; free_univ_names=[]; -}, new_fv_set () +}, empty () -let singleton_fvar fv = +let singleton_fvar fv : free_vars_and_fvars = fst no_free_vars, - add fv.fv_name.v (new_fv_set ()) + add fv.fv_name.v (empty ()) let singleton_bv x = {fst no_free_vars with free_names=[x]}, snd no_free_vars let singleton_uv x = {fst no_free_vars with free_uvars=[x]}, snd no_free_vars @@ -235,7 +235,7 @@ and free_names_and_uvars_ascription asc use_cache = and free_names_and_uvars t use_cache = let t = Subst.compress t in match !t.vars with - | Some n when not (should_invalidate_cache n use_cache) -> n, new_fv_set () + | Some n when not (should_invalidate_cache n use_cache) -> n, empty () | _ -> t.vars := None; let n = free_names_and_uvs' t use_cache in @@ -250,7 +250,7 @@ and free_names_and_uvars_comp c use_cache = | Some n -> if should_invalidate_cache n use_cache then (c.vars := None; free_names_and_uvars_comp c use_cache) - else n, new_fv_set () + else n, empty () | _ -> let n = match c.n with | GTotal t @@ -296,9 +296,6 @@ and should_invalidate_cache n use_cache = //note use_cache is set false ONLY for fvars, which is not maintained at each AST node //see the comment above -let new_uv_set () : uvars = empty () -let new_universe_uvar_set () : flat_set universe_uvar = empty () -let empty = empty () let names t = from_list (fst (free_names_and_uvars t Def)).free_names let uvars t = from_list (fst (free_names_and_uvars t Def)).free_uvars diff --git a/src/syntax/FStar.Syntax.Free.fsti b/src/syntax/FStar.Syntax.Free.fsti index bc503bcf33e..37a8dcb4802 100644 --- a/src/syntax/FStar.Syntax.Free.fsti +++ b/src/syntax/FStar.Syntax.Free.fsti @@ -23,20 +23,16 @@ open FStar.Compiler.FlatSet open FStar.Syntax open FStar.Syntax.Syntax -val new_uv_set : unit -> uvars -val new_universe_uvar_set : unit -> flat_set universe_uvar - -val empty: flat_set bv -val names: term -> flat_set bv -val uvars: term -> flat_set ctx_uvar -val univs: term -> flat_set universe_uvar -val univnames: term -> flat_set univ_name -val univnames_comp: comp -> flat_set univ_name +val names: term -> FlatSet.t bv +val uvars: term -> FlatSet.t ctx_uvar +val univs: term -> FlatSet.t universe_uvar +val univnames: term -> FlatSet.t univ_name +val univnames_comp: comp -> FlatSet.t univ_name val fvars: term -> RBSet.t Ident.lident -val names_of_binders: binders -> flat_set bv +val names_of_binders: binders -> FlatSet.t bv -val uvars_uncached: term -> flat_set ctx_uvar -val uvars_full: term -> flat_set ctx_uvar +val uvars_uncached: term -> FlatSet.t ctx_uvar +val uvars_full: term -> FlatSet.t ctx_uvar (* Bad place for these instances. But they cannot be instance Syntax.Syntax since they reference the UF graph. *) diff --git a/src/syntax/FStar.Syntax.Print.Pretty.fst b/src/syntax/FStar.Syntax.Print.Pretty.fst index a6e6cb4ea40..a926b380e68 100644 --- a/src/syntax/FStar.Syntax.Print.Pretty.fst +++ b/src/syntax/FStar.Syntax.Print.Pretty.fst @@ -125,7 +125,7 @@ let tscheme_to_string (ts:tscheme) : string = GenSym.with_frozen_gensym (fun () ) let pat_to_string (p:pat) : string = GenSym.with_frozen_gensym (fun () -> - let e = Resugar.resugar_pat p Syntax.no_names in + let e = Resugar.resugar_pat p (Class.Setlike.empty ()) in let d = ToDocument.pat_to_document e in pp d ) diff --git a/src/syntax/FStar.Syntax.Syntax.fst b/src/syntax/FStar.Syntax.Syntax.fst index eeee44edd65..84fd96b0b9e 100644 --- a/src/syntax/FStar.Syntax.Syntax.fst +++ b/src/syntax/FStar.Syntax.Syntax.fst @@ -160,17 +160,9 @@ instance ord_fv : ord lident = let syn p k f = f k p let mk_fvs () = Util.mk_ref None let mk_uvs () = Util.mk_ref None -let new_bv_set () : FlatSet.t bv = empty () -let new_id_set () : FlatSet.t ident = empty () -let new_fv_set () : RBSet.t lident = empty () -let new_universe_names_set () : FlatSet.t univ_name = empty () - -let no_names = new_bv_set() -let no_fvars = new_fv_set() -let no_universe_names = new_universe_names_set () + //let memo_no_uvs = Util.mk_ref (Some no_uvs) //let memo_no_names = Util.mk_ref (Some no_names) -let freenames_of_list l = addn l no_names let list_of_freenames (fvs:freenames) = elems fvs (* Constructors for each term form; NO HASH CONSING; just makes all the auxiliary data at each node *) @@ -295,7 +287,7 @@ let is_top_level = function | _ -> false let freenames_of_binders (bs:binders) : freenames = - List.fold_right (fun b out -> add b.binder_bv out) bs no_names + List.fold_right (fun b out -> add b.binder_bv out) bs (empty ()) let binders_of_list fvs : binders = (fvs |> List.map (fun t -> mk_binder t)) let binders_of_freenames (fvs:freenames) = elems fvs |> binders_of_list diff --git a/src/syntax/FStar.Syntax.Syntax.fsti b/src/syntax/FStar.Syntax.Syntax.fsti index 38f7cc3bad2..0368a976caa 100644 --- a/src/syntax/FStar.Syntax.Syntax.fsti +++ b/src/syntax/FStar.Syntax.Syntax.fsti @@ -751,10 +751,6 @@ val lookup_aq : bv -> antiquotations -> term // This is set in FStar.Main.main, where all modules are in-scope. val lazy_chooser : ref (option (lazy_kind -> lazyinfo -> term)) -val new_bv_set: unit -> FlatSet.t bv -val new_id_set: unit -> FlatSet.t ident -val new_fv_set: unit -> RBSet.t lident -val new_universe_names_set: unit -> FlatSet.t univ_name val mod_name: modul -> lident @@ -804,13 +800,7 @@ val teff: term val is_teff: term -> bool val is_type: term -> bool -val no_names: freenames -val no_universe_names: FlatSet.t univ_name -val no_fvars: RBSet.t lident - -val freenames_of_list: list bv -> freenames val freenames_of_binders: binders -> freenames -val list_of_freenames: freenames -> list bv val binders_of_freenames: freenames -> binders val binders_of_list: list bv -> binders diff --git a/src/tactics/FStar.Tactics.V1.Basic.fst b/src/tactics/FStar.Tactics.V1.Basic.fst index eec1d385122..af44859d630 100644 --- a/src/tactics/FStar.Tactics.V1.Basic.fst +++ b/src/tactics/FStar.Tactics.V1.Basic.fst @@ -382,7 +382,7 @@ let __do_unify_wflags let all_uvars = (match check_side with - | Check_none -> Free.new_uv_set () + | Check_none -> empty () | Check_left_only -> Free.uvars t1 | Check_right_only -> Free.uvars t2 | Check_both -> union (Free.uvars t1) (Free.uvars t2)) @@ -988,7 +988,7 @@ let t_apply (uopt:bool) (only_match:bool) (tc_resolved_uvars:bool) (tm:term) : t List.fold_right (fun (_, _, uv) s -> union s (SF.uvars (U.ctx_uvar_typ uv))) uvs - (SF.new_uv_set ()) + (empty ()) in let free_in_some_goal uv = mem uv uvset in solve' goal w ;! diff --git a/src/tactics/FStar.Tactics.V2.Basic.fst b/src/tactics/FStar.Tactics.V2.Basic.fst index 37e08e1862f..48bbf3ff425 100644 --- a/src/tactics/FStar.Tactics.V2.Basic.fst +++ b/src/tactics/FStar.Tactics.V2.Basic.fst @@ -364,7 +364,7 @@ let __do_unify_wflags let all_uvars = (match check_side with - | Check_none -> Free.new_uv_set () + | Check_none -> empty () | Check_left_only -> Free.uvars t1 | Check_right_only -> Free.uvars t2 | Check_both -> union (Free.uvars t1) (Free.uvars t2)) @@ -989,7 +989,7 @@ let t_apply (uopt:bool) (only_match:bool) (tc_resolved_uvars:bool) (tm:term) : t List.fold_right (fun (_, _, uv) s -> union s (SF.uvars (U.ctx_uvar_typ uv))) uvs - (SF.new_uv_set ()) + (empty ()) in let free_in_some_goal uv = mem uv uvset in solve' goal w ;! diff --git a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst index 9e257556543..a2809bf79d9 100644 --- a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst +++ b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst @@ -774,15 +774,16 @@ let check_no_aq (aq : antiquotations_temp) : unit = let check_linear_pattern_variables pats r = // returns the set of pattern variables - let rec pat_vars p = match p.v with + let rec pat_vars p : RBSet.t bv = + match p.v with | Pat_dot_term _ - | Pat_constant _ -> S.no_names + | Pat_constant _ -> empty () | Pat_var x -> (* Only consider variables that actually have names, not wildcards. *) if string_of_id x.ppname = Ident.reserved_prefix - then S.no_names - else add x S.no_names + then empty () + else singleton x | Pat_cons(_, _, pats) -> let aux out (p, _) = let p_vars = pat_vars p in @@ -798,7 +799,7 @@ let check_linear_pattern_variables pats r = r in - List.fold_left aux S.no_names pats + List.fold_left aux (empty ()) pats in // check that the same variables are bound in each pattern @@ -1427,7 +1428,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an then aux (union acc set) sets else Some (List.hd (elems i)) in - aux (new_id_set ()) sets + aux (empty ()) sets in begin match check_disjoint bvss with | None -> () diff --git a/src/typechecker/FStar.TypeChecker.DMFF.fst b/src/typechecker/FStar.TypeChecker.DMFF.fst index bd52925bf3c..666f63a077a 100644 --- a/src/typechecker/FStar.TypeChecker.DMFF.fst +++ b/src/typechecker/FStar.TypeChecker.DMFF.fst @@ -616,7 +616,7 @@ and star_type' env t = let s = List.fold_left (fun s ({binder_bv=bv}) -> non_dependent_or_raise s bv.sort ; add bv s - ) S.no_names binders in + ) (Class.Setlike.empty ()) binders in let ct = U.comp_result c in non_dependent_or_raise s ct ; let k = n - List.length binders in diff --git a/src/typechecker/FStar.TypeChecker.Env.fst b/src/typechecker/FStar.TypeChecker.Env.fst index a47eae5df9a..c59d0cc38e8 100644 --- a/src/typechecker/FStar.TypeChecker.Env.fst +++ b/src/typechecker/FStar.TypeChecker.Env.fst @@ -1747,7 +1747,7 @@ let finish_module = // Collections from the environment // //////////////////////////////////////////////////////////// let uvars_in_env env = - let no_uvs = Free.new_uv_set () in + let no_uvs = empty () in let rec aux out g = match g with | [] -> out | Binding_univ _ :: tl -> aux out tl @@ -1757,7 +1757,7 @@ let uvars_in_env env = aux no_uvs env.gamma let univ_vars env = - let no_univs = Free.new_universe_uvar_set () in + let no_univs = empty () in let rec aux out g = match g with | [] -> out | Binding_univ _ :: tl -> aux out tl @@ -1767,7 +1767,7 @@ let univ_vars env = aux no_univs env.gamma let univnames env = - let no_univ_names = Syntax.no_universe_names in + let no_univ_names = empty () in let rec aux out g = match g with | [] -> out | Binding_univ uname :: tl -> aux (add uname out) tl diff --git a/src/typechecker/FStar.TypeChecker.Rel.fst b/src/typechecker/FStar.TypeChecker.Rel.fst index e15ec77e6c3..a95b34d944d 100644 --- a/src/typechecker/FStar.TypeChecker.Rel.fst +++ b/src/typechecker/FStar.TypeChecker.Rel.fst @@ -1176,12 +1176,13 @@ let restrict_all_uvars env (tgt:ctx_uvar) (bs:binders) (sources:list ctx_uvar) w List.fold_right (restrict_ctx env tgt bs) sources wl let intersect_binders (g:gamma) (v1:binders) (v2:binders) : binders = - let as_set v = - v |> List.fold_left (fun out x -> add x.binder_bv out) S.no_names in + let as_set (v:binders) : RBSet.t bv = + v |> List.fold_left (fun out x -> add x.binder_bv out) (empty ()) + in let v1_set = as_set v1 in let ctx_binders = List.fold_left (fun out b -> match b with Binding_var x -> add x out | _ -> out) - S.no_names + (empty ()) g in let isect, _ = From b51e4296024a7d3b736f7f231bf4288940ea37ce Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Tue, 23 Apr 2024 20:34:40 -0700 Subject: [PATCH 081/239] Remove dead code --- src/parser/FStar.Parser.Dep.fst | 2 -- src/syntax/FStar.Syntax.Util.fst | 3 --- 2 files changed, 5 deletions(-) diff --git a/src/parser/FStar.Parser.Dep.fst b/src/parser/FStar.Parser.Dep.fst index d3fce3581f0..c8295be9966 100644 --- a/src/parser/FStar.Parser.Dep.fst +++ b/src/parser/FStar.Parser.Dep.fst @@ -39,8 +39,6 @@ open FStar.Class.Show module Const = FStar.Parser.Const module BU = FStar.Compiler.Util -module FlatSet = FStar.Compiler.FlatSet - let profile f c = Profiling.profile f None c (* Meant to write to a file as an out_channel. If an exception is raised, diff --git a/src/syntax/FStar.Syntax.Util.fst b/src/syntax/FStar.Syntax.Util.fst index bd075a0a1c9..3f608f402cf 100644 --- a/src/syntax/FStar.Syntax.Util.fst +++ b/src/syntax/FStar.Syntax.Util.fst @@ -108,9 +108,6 @@ let null_binders_of_tks (tks:list (typ * bqual)) : binders = let binders_of_tks (tks:list (typ * bqual)) : binders = tks |> List.map (fun (t, imp) -> mk_binder_with_attrs (new_bv (Some t.pos) t) imp None []) -let binders_of_freevars (fvs : FlatSet.t bv) = - Class.Setlike.elems fvs |> List.map mk_binder - let mk_subst s = [s] let subst_of_list (formals:binders) (actuals:args) : subst_t = From 3e7f211cdb0eed1fbb3a98d580451b0fad96db7b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 24 Apr 2024 08:49:06 -0700 Subject: [PATCH 082/239] snap --- .../fstar-lib/generated/FStar_CheckedFiles.ml | 2 +- .../generated/FStar_Class_Binders.ml | 54 ++- .../generated/FStar_Class_Setlike.ml | 298 ++++++++++++++ .../generated/FStar_Compiler_FlatSet.ml | 138 +++++++ .../generated/FStar_Compiler_RBSet.ml | 218 ++++++++++ .../fstar-lib/generated/FStar_Compiler_Set.ml | 112 ----- ocaml/fstar-lib/generated/FStar_Defensive.ml | 22 +- ...ar_Extraction_ML_RemoveUnusedParameters.ml | 55 ++- .../generated/FStar_Interactive_Ide.ml | 12 +- .../generated/FStar_SMTEncoding_EncodeTerm.ml | 36 +- .../generated/FStar_SMTEncoding_Term.ml | 17 +- .../fstar-lib/generated/FStar_Syntax_DsEnv.ml | 125 +++--- .../fstar-lib/generated/FStar_Syntax_Free.ml | 254 +++++++----- .../generated/FStar_Syntax_Print_Pretty.ml | 8 +- .../generated/FStar_Syntax_Resugar.ml | 22 +- .../generated/FStar_Syntax_Syntax.ml | 48 ++- .../fstar-lib/generated/FStar_Syntax_Util.ml | 69 ++-- .../generated/FStar_Tactics_Monad.ml | 6 +- .../generated/FStar_Tactics_V1_Basic.ml | 140 +++++-- .../generated/FStar_Tactics_V2_Basic.ml | 172 ++++++-- .../generated/FStar_ToSyntax_ToSyntax.ml | 389 ++++++++++++------ .../generated/FStar_TypeChecker_Core.ml | 14 +- .../generated/FStar_TypeChecker_DMFF.ml | 81 ++-- .../FStar_TypeChecker_DeferredImplicits.ml | 81 ---- .../generated/FStar_TypeChecker_Env.ml | 147 +++++-- .../generated/FStar_TypeChecker_Generalize.ml | 132 ++++-- .../generated/FStar_TypeChecker_Positivity.ml | 5 +- .../generated/FStar_TypeChecker_Rel.ml | 240 ++++++++--- .../generated/FStar_TypeChecker_Tc.ml | 8 +- .../generated/FStar_TypeChecker_TcTerm.ml | 234 +++++++---- .../generated/FStar_TypeChecker_Util.ml | 36 +- .../fstar-tests/generated/FStar_Tests_Data.ml | 106 +++++ .../fstar-tests/generated/FStar_Tests_Test.ml | 2 + 33 files changed, 2355 insertions(+), 928 deletions(-) create mode 100644 ocaml/fstar-lib/generated/FStar_Class_Setlike.ml create mode 100644 ocaml/fstar-lib/generated/FStar_Compiler_FlatSet.ml create mode 100644 ocaml/fstar-lib/generated/FStar_Compiler_RBSet.ml delete mode 100644 ocaml/fstar-lib/generated/FStar_Compiler_Set.ml create mode 100644 ocaml/fstar-tests/generated/FStar_Tests_Data.ml diff --git a/ocaml/fstar-lib/generated/FStar_CheckedFiles.ml b/ocaml/fstar-lib/generated/FStar_CheckedFiles.ml index b650fd7cbe9..729e546791b 100644 --- a/ocaml/fstar-lib/generated/FStar_CheckedFiles.ml +++ b/ocaml/fstar-lib/generated/FStar_CheckedFiles.ml @@ -1,5 +1,5 @@ open Prims -let (cache_version_number : Prims.int) = (Prims.of_int (65)) +let (cache_version_number : Prims.int) = (Prims.of_int (66)) type tc_result = { checked_module: FStar_Syntax_Syntax.modul ; diff --git a/ocaml/fstar-lib/generated/FStar_Class_Binders.ml b/ocaml/fstar-lib/generated/FStar_Class_Binders.ml index 794f05147b7..4b59d1215d7 100644 --- a/ocaml/fstar-lib/generated/FStar_Class_Binders.ml +++ b/ocaml/fstar-lib/generated/FStar_Class_Binders.ml @@ -1,22 +1,32 @@ open Prims type 'a hasNames = { - freeNames: 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.set } + freeNames: 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.flat_set } let __proj__MkhasNames__item__freeNames : - 'a . 'a hasNames -> 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.set = - fun projectee -> match projectee with | { freeNames;_} -> freeNames + 'a . + 'a hasNames -> + 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.flat_set + = fun projectee -> match projectee with | { freeNames;_} -> freeNames let freeNames : - 'a . 'a hasNames -> 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.set = + 'a . + 'a hasNames -> + 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.flat_set + = fun projectee -> match projectee with | { freeNames = freeNames1;_} -> freeNames1 type 'a hasBinders = { - boundNames: 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.set } + boundNames: 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.flat_set } let __proj__MkhasBinders__item__boundNames : - 'a . 'a hasBinders -> 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.set = - fun projectee -> match projectee with | { boundNames;_} -> boundNames + 'a . + 'a hasBinders -> + 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.flat_set + = fun projectee -> match projectee with | { boundNames;_} -> boundNames let boundNames : - 'a . 'a hasBinders -> 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.set = + 'a . + 'a hasBinders -> + 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.flat_set + = fun projectee -> match projectee with | { boundNames = boundNames1;_} -> boundNames1 let (hasNames_term : FStar_Syntax_Syntax.term hasNames) = @@ -30,7 +40,11 @@ let (hasNames_comp : FStar_Syntax_Syntax.comp hasNames) = | FStar_Syntax_Syntax.GTotal t -> FStar_Syntax_Free.names t | FStar_Syntax_Syntax.Comp ct -> let uu___ = - FStar_Compiler_Set.empty FStar_Syntax_Syntax.ord_bv () in + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) ()) in let uu___1 = let uu___2 = FStar_Syntax_Free.names ct.FStar_Syntax_Syntax.result_typ in @@ -42,11 +56,25 @@ let (hasNames_comp : FStar_Syntax_Syntax.comp hasNames) = ct.FStar_Syntax_Syntax.effect_args in uu___2 :: uu___3 in FStar_Compiler_List.fold_left - (FStar_Compiler_Set.union FStar_Syntax_Syntax.ord_bv) uu___ - uu___1) + (fun uu___3 -> + fun uu___2 -> + (Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)))) uu___3 uu___2) + uu___ uu___1) } let (hasBinders_list_bv : FStar_Syntax_Syntax.bv Prims.list hasBinders) = - { boundNames = (FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_bv) } + { + boundNames = + (fun uu___ -> + (Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)))) uu___) + } let (hasBinders_set_bv : - FStar_Syntax_Syntax.bv FStar_Compiler_Set.set hasBinders) = + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.flat_set hasBinders) = { boundNames = (fun x -> x) } \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Class_Setlike.ml b/ocaml/fstar-lib/generated/FStar_Class_Setlike.ml new file mode 100644 index 00000000000..c9d1be35da4 --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_Class_Setlike.ml @@ -0,0 +1,298 @@ +open Prims +type ('e, 's) setlike = + { + empty: unit -> 's ; + singleton: 'e -> 's ; + is_empty: 's -> Prims.bool ; + add: 'e -> 's -> 's ; + remove: 'e -> 's -> 's ; + mem: 'e -> 's -> Prims.bool ; + equal: 's -> 's -> Prims.bool ; + subset: 's -> 's -> Prims.bool ; + union: 's -> 's -> 's ; + inter: 's -> 's -> 's ; + diff: 's -> 's -> 's ; + for_all: ('e -> Prims.bool) -> 's -> Prims.bool ; + for_any: ('e -> Prims.bool) -> 's -> Prims.bool ; + elems: 's -> 'e Prims.list ; + collect: ('e -> 's) -> 'e Prims.list -> 's ; + from_list: 'e Prims.list -> 's ; + addn: 'e Prims.list -> 's -> 's } +let __proj__Mksetlike__item__empty : 'e 's . ('e, 's) setlike -> unit -> 's = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> empty +let __proj__Mksetlike__item__singleton : 'e 's . ('e, 's) setlike -> 'e -> 's + = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> singleton +let __proj__Mksetlike__item__is_empty : + 'e 's . ('e, 's) setlike -> 's -> Prims.bool = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> is_empty +let __proj__Mksetlike__item__add : 'e 's . ('e, 's) setlike -> 'e -> 's -> 's + = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> add +let __proj__Mksetlike__item__remove : + 'e 's . ('e, 's) setlike -> 'e -> 's -> 's = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> remove +let __proj__Mksetlike__item__mem : + 'e 's . ('e, 's) setlike -> 'e -> 's -> Prims.bool = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> mem +let __proj__Mksetlike__item__equal : + 'e 's . ('e, 's) setlike -> 's -> 's -> Prims.bool = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> equal +let __proj__Mksetlike__item__subset : + 'e 's . ('e, 's) setlike -> 's -> 's -> Prims.bool = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> subset +let __proj__Mksetlike__item__union : + 'e 's . ('e, 's) setlike -> 's -> 's -> 's = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> union +let __proj__Mksetlike__item__inter : + 'e 's . ('e, 's) setlike -> 's -> 's -> 's = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> inter +let __proj__Mksetlike__item__diff : + 'e 's . ('e, 's) setlike -> 's -> 's -> 's = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> diff +let __proj__Mksetlike__item__for_all : + 'e 's . ('e, 's) setlike -> ('e -> Prims.bool) -> 's -> Prims.bool = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> for_all +let __proj__Mksetlike__item__for_any : + 'e 's . ('e, 's) setlike -> ('e -> Prims.bool) -> 's -> Prims.bool = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> for_any +let __proj__Mksetlike__item__elems : + 'e 's . ('e, 's) setlike -> 's -> 'e Prims.list = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> elems +let __proj__Mksetlike__item__collect : + 'e 's . ('e, 's) setlike -> ('e -> 's) -> 'e Prims.list -> 's = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> collect +let __proj__Mksetlike__item__from_list : + 'e 's . ('e, 's) setlike -> 'e Prims.list -> 's = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> from_list +let __proj__Mksetlike__item__addn : + 'e 's . ('e, 's) setlike -> 'e Prims.list -> 's -> 's = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> addn +let empty : 'e . unit -> ('e, Obj.t) setlike -> unit -> Obj.t = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton; is_empty; add; remove; mem; equal; + subset; union; inter; diff; for_all; for_any; elems; collect; + from_list; addn;_} -> empty1 +let singleton : 'e . unit -> ('e, Obj.t) setlike -> 'e -> Obj.t = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty; add; remove; + mem; equal; subset; union; inter; diff; for_all; for_any; elems; + collect; from_list; addn;_} -> singleton1 +let is_empty : 'e . unit -> ('e, Obj.t) setlike -> Obj.t -> Prims.bool = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add; remove; mem; equal; subset; union; inter; diff; for_all; + for_any; elems; collect; from_list; addn;_} -> is_empty1 +let add : 'e . unit -> ('e, Obj.t) setlike -> 'e -> Obj.t -> Obj.t = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove; mem; equal; subset; union; inter; diff; + for_all; for_any; elems; collect; from_list; addn;_} -> add1 +let remove : 'e . unit -> ('e, Obj.t) setlike -> 'e -> Obj.t -> Obj.t = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem; equal; subset; union; inter; + diff; for_all; for_any; elems; collect; from_list; addn;_} -> + remove1 +let mem : 'e . unit -> ('e, Obj.t) setlike -> 'e -> Obj.t -> Prims.bool = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal; subset; union; + inter; diff; for_all; for_any; elems; collect; from_list; addn;_} + -> mem1 +let equal : 'e . unit -> ('e, Obj.t) setlike -> Obj.t -> Obj.t -> Prims.bool + = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> equal1 +let subset : 'e . unit -> ('e, Obj.t) setlike -> Obj.t -> Obj.t -> Prims.bool + = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union; inter; diff; for_all; for_any; elems; + collect; from_list; addn;_} -> subset1 +let union : 'e . unit -> ('e, Obj.t) setlike -> Obj.t -> Obj.t -> Obj.t = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union = union1; inter; diff; for_all; for_any; + elems; collect; from_list; addn;_} -> union1 +let inter : 'e . unit -> ('e, Obj.t) setlike -> Obj.t -> Obj.t -> Obj.t = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union = union1; inter = inter1; diff; for_all; + for_any; elems; collect; from_list; addn;_} -> inter1 +let diff : 'e . unit -> ('e, Obj.t) setlike -> Obj.t -> Obj.t -> Obj.t = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union = union1; inter = inter1; diff = diff1; + for_all; for_any; elems; collect; from_list; addn;_} -> diff1 +let for_all : + 'e . + unit -> ('e, Obj.t) setlike -> ('e -> Prims.bool) -> Obj.t -> Prims.bool + = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union = union1; inter = inter1; diff = diff1; + for_all = for_all1; for_any; elems; collect; from_list; addn;_} -> + for_all1 +let for_any : + 'e . + unit -> ('e, Obj.t) setlike -> ('e -> Prims.bool) -> Obj.t -> Prims.bool + = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union = union1; inter = inter1; diff = diff1; + for_all = for_all1; for_any = for_any1; elems; collect; from_list; + addn;_} -> for_any1 +let elems : 'e . unit -> ('e, Obj.t) setlike -> Obj.t -> 'e Prims.list = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union = union1; inter = inter1; diff = diff1; + for_all = for_all1; for_any = for_any1; elems = elems1; collect; + from_list; addn;_} -> elems1 +let collect : + 'e . unit -> ('e, Obj.t) setlike -> ('e -> Obj.t) -> 'e Prims.list -> Obj.t + = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union = union1; inter = inter1; diff = diff1; + for_all = for_all1; for_any = for_any1; elems = elems1; + collect = collect1; from_list; addn;_} -> collect1 +let from_list : 'e . unit -> ('e, Obj.t) setlike -> 'e Prims.list -> Obj.t = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union = union1; inter = inter1; diff = diff1; + for_all = for_all1; for_any = for_any1; elems = elems1; + collect = collect1; from_list = from_list1; addn;_} -> from_list1 +let addn : + 'e . unit -> ('e, Obj.t) setlike -> 'e Prims.list -> Obj.t -> Obj.t = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union = union1; inter = inter1; diff = diff1; + for_all = for_all1; for_any = for_any1; elems = elems1; + collect = collect1; from_list = from_list1; addn = addn1;_} -> + addn1 +let symdiff : 'e 's . ('e, 's) setlike -> 's -> 's -> 's = + fun uu___2 -> + fun uu___1 -> + fun uu___ -> + (fun uu___ -> + fun s1 -> + fun s2 -> + Obj.magic + (diff () (Obj.magic uu___) (Obj.magic s1) (Obj.magic s2))) + uu___2 uu___1 uu___ \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Compiler_FlatSet.ml b/ocaml/fstar-lib/generated/FStar_Compiler_FlatSet.ml new file mode 100644 index 00000000000..0a701e59788 --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_Compiler_FlatSet.ml @@ -0,0 +1,138 @@ +open Prims +type 't flat_set = 't Prims.list +type 'a t = 'a flat_set +let rec add : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a flat_set -> 'a flat_set + = + fun uu___ -> + fun x -> + fun s -> + match s with + | [] -> [x] + | y::yy -> + let uu___1 = + FStar_Class_Deq.op_Equals_Question + (FStar_Class_Ord.ord_eq uu___) x y in + if uu___1 + then s + else (let uu___3 = add uu___ x yy in y :: uu___3) +let empty : 'a . unit -> 'a flat_set = fun uu___ -> [] +let from_list : 'a . 'a FStar_Class_Ord.ord -> 'a Prims.list -> 'a flat_set = + fun uu___ -> fun xs -> FStar_Class_Ord.dedup uu___ xs +let mem : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a flat_set -> Prims.bool = + fun uu___ -> + fun x -> + fun s -> + FStar_Compiler_List.existsb + (fun y -> + FStar_Class_Deq.op_Equals_Question + (FStar_Class_Ord.ord_eq uu___) x y) s +let singleton : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a flat_set = + fun uu___ -> fun x -> [x] +let is_empty : 'a . 'a flat_set -> Prims.bool = fun s -> Prims.uu___is_Nil s +let addn : + 'a . 'a FStar_Class_Ord.ord -> 'a Prims.list -> 'a flat_set -> 'a flat_set + = + fun uu___ -> + fun xs -> fun ys -> FStar_Compiler_List.fold_right (add uu___) xs ys +let rec remove : + 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a flat_set -> 'a flat_set = + fun uu___ -> + fun x -> + fun s -> + match s with + | [] -> [] + | y::yy -> + let uu___1 = + FStar_Class_Deq.op_Equals_Question + (FStar_Class_Ord.ord_eq uu___) x y in + if uu___1 + then yy + else (let uu___3 = remove uu___ x yy in y :: uu___3) +let elems : 'a . 'a flat_set -> 'a Prims.list = fun s -> s +let for_all : 'a . ('a -> Prims.bool) -> 'a flat_set -> Prims.bool = + fun p -> + fun s -> let uu___ = elems s in FStar_Compiler_List.for_all p uu___ +let for_any : 'a . ('a -> Prims.bool) -> 'a flat_set -> Prims.bool = + fun p -> + fun s -> let uu___ = elems s in FStar_Compiler_List.existsb p uu___ +let subset : + 'a . 'a FStar_Class_Ord.ord -> 'a flat_set -> 'a flat_set -> Prims.bool = + fun uu___ -> fun s1 -> fun s2 -> for_all (fun y -> mem uu___ y s2) s1 +let equal : + 'a . 'a FStar_Class_Ord.ord -> 'a flat_set -> 'a flat_set -> Prims.bool = + fun uu___ -> + fun s1 -> + fun s2 -> + let uu___1 = FStar_Class_Ord.sort uu___ s1 in + let uu___2 = FStar_Class_Ord.sort uu___ s2 in + FStar_Class_Deq.op_Equals_Question + (FStar_Class_Ord.ord_eq (FStar_Class_Ord.ord_list uu___)) uu___1 + uu___2 +let union : + 'a . 'a FStar_Class_Ord.ord -> 'a flat_set -> 'a flat_set -> 'a flat_set = + fun uu___ -> + fun s1 -> + fun s2 -> + FStar_Compiler_List.fold_left (fun s -> fun x -> add uu___ x s) s1 s2 +let inter : + 'a . 'a FStar_Class_Ord.ord -> 'a flat_set -> 'a flat_set -> 'a flat_set = + fun uu___ -> + fun s1 -> + fun s2 -> FStar_Compiler_List.filter (fun y -> mem uu___ y s2) s1 +let diff : + 'a . 'a FStar_Class_Ord.ord -> 'a flat_set -> 'a flat_set -> 'a flat_set = + fun uu___ -> + fun s1 -> + fun s2 -> + FStar_Compiler_List.filter + (fun y -> let uu___1 = mem uu___ y s2 in Prims.op_Negation uu___1) + s1 +let collect : + 'a 'b . + 'b FStar_Class_Ord.ord -> + ('a -> 'b flat_set) -> 'a Prims.list -> 'b flat_set + = + fun uu___ -> + fun f -> + fun l -> + let uu___1 = empty () in + FStar_Compiler_List.fold_right + (fun x -> fun acc -> let uu___2 = f x in union uu___ uu___2 acc) l + uu___1 +let showable_set : + 'a . + 'a FStar_Class_Ord.ord -> + 'a FStar_Class_Show.showable -> 'a flat_set FStar_Class_Show.showable + = + fun uu___ -> + fun uu___1 -> + { + FStar_Class_Show.show = + (fun s -> + let uu___2 = elems s in + FStar_Class_Show.show (FStar_Class_Show.show_list uu___1) uu___2) + } +let setlike_flat_set : + 'a . + 'a FStar_Class_Ord.ord -> ('a, 'a flat_set) FStar_Class_Setlike.setlike + = + fun uu___ -> + { + FStar_Class_Setlike.empty = empty; + FStar_Class_Setlike.singleton = (singleton uu___); + FStar_Class_Setlike.is_empty = is_empty; + FStar_Class_Setlike.add = (add uu___); + FStar_Class_Setlike.remove = (remove uu___); + FStar_Class_Setlike.mem = (mem uu___); + FStar_Class_Setlike.equal = (equal uu___); + FStar_Class_Setlike.subset = (subset uu___); + FStar_Class_Setlike.union = (union uu___); + FStar_Class_Setlike.inter = (inter uu___); + FStar_Class_Setlike.diff = (diff uu___); + FStar_Class_Setlike.for_all = for_all; + FStar_Class_Setlike.for_any = for_any; + FStar_Class_Setlike.elems = elems; + FStar_Class_Setlike.collect = (collect uu___); + FStar_Class_Setlike.from_list = (from_list uu___); + FStar_Class_Setlike.addn = (addn uu___) + } \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Compiler_RBSet.ml b/ocaml/fstar-lib/generated/FStar_Compiler_RBSet.ml new file mode 100644 index 00000000000..8031fabbff8 --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_Compiler_RBSet.ml @@ -0,0 +1,218 @@ +open Prims +type color = + | R + | B +let (uu___is_R : color -> Prims.bool) = + fun projectee -> match projectee with | R -> true | uu___ -> false +let (uu___is_B : color -> Prims.bool) = + fun projectee -> match projectee with | B -> true | uu___ -> false +type 'a rbset = + | L + | N of (color * 'a rbset * 'a * 'a rbset) +let uu___is_L : 'a . 'a rbset -> Prims.bool = + fun projectee -> match projectee with | L -> true | uu___ -> false +let uu___is_N : 'a . 'a rbset -> Prims.bool = + fun projectee -> match projectee with | N _0 -> true | uu___ -> false +let __proj__N__item___0 : 'a . 'a rbset -> (color * 'a rbset * 'a * 'a rbset) + = fun projectee -> match projectee with | N _0 -> _0 +type 'a t = 'a rbset +let empty : 'uuuuu . unit -> 'uuuuu rbset = fun uu___ -> L +let singleton : 'a . 'a -> 'a rbset = fun x -> N (R, L, x, L) +let is_empty : 'uuuuu . unit -> 'uuuuu rbset -> Prims.bool = + fun uu___ -> uu___is_L +let balance : + 'uuuuu . color -> 'uuuuu rbset -> 'uuuuu -> 'uuuuu rbset -> 'uuuuu rbset = + fun c -> + fun l -> + fun x -> + fun r -> + match (c, l, x, r) with + | (B, N (R, N (R, a, x1, b), y, c1), z, d) -> + N (R, (N (B, a, x1, b)), y, (N (B, c1, z, d))) + | (B, a, x1, N (R, N (R, b, y, c1), z, d)) -> + N (R, (N (B, a, x1, b)), y, (N (B, c1, z, d))) + | (B, N (R, a, x1, N (R, b, y, c1)), z, d) -> + N (R, (N (B, a, x1, b)), y, (N (B, c1, z, d))) + | (B, a, x1, N (R, b, y, N (R, c1, z, d))) -> + N (R, (N (B, a, x1, b)), y, (N (B, c1, z, d))) + | (c1, l1, x1, r1) -> N (c1, l1, x1, r1) +let blackroot : 'a . 'a rbset -> 'a rbset = + fun t1 -> match t1 with | N (uu___, l, x, r) -> N (B, l, x, r) +let add : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a rbset -> 'a rbset = + fun uu___ -> + fun x -> + fun s -> + let rec add' s1 = + match s1 with + | L -> N (R, L, x, L) + | N (c, a1, y, b) -> + let uu___1 = FStar_Class_Ord.op_Less_Question uu___ x y in + if uu___1 + then let uu___2 = add' a1 in balance c uu___2 y b + else + (let uu___3 = FStar_Class_Ord.op_Greater_Question uu___ x y in + if uu___3 + then let uu___4 = add' b in balance c a1 y uu___4 + else s1) in + let uu___1 = add' s in blackroot uu___1 +let rec extract_min : + 'a . 'a FStar_Class_Ord.ord -> 'a rbset -> ('a rbset * 'a) = + fun uu___ -> + fun t1 -> + match t1 with + | N (uu___1, L, x, L) -> (L, x) + | N (c, N (uu___1, L, x, L), y, L) -> ((N (B, L, x, L)), y) + | N (c, a1, x, b) -> + let uu___1 = extract_min uu___ a1 in + (match uu___1 with | (a', y) -> ((balance c a' x b), y)) +let rec remove : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a rbset -> 'a rbset = + fun uu___ -> + fun x -> + fun t1 -> + match t1 with + | L -> L + | N (c, l, y, r) -> + let uu___1 = FStar_Class_Ord.op_Less_Question uu___ x y in + if uu___1 + then let uu___2 = remove uu___ x l in balance c uu___2 y r + else + (let uu___3 = FStar_Class_Ord.op_Greater_Question uu___ x y in + if uu___3 + then let uu___4 = remove uu___ x r in balance c l y uu___4 + else + if uu___is_L r + then l + else + (let uu___6 = extract_min uu___ r in + match uu___6 with | (r', y') -> balance c l y' r')) +let rec mem : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a rbset -> Prims.bool = + fun uu___ -> + fun x -> + fun s -> + match s with + | L -> false + | N (uu___1, a1, y, b) -> + let uu___2 = FStar_Class_Ord.op_Less_Question uu___ x y in + if uu___2 + then mem uu___ x a1 + else + (let uu___4 = FStar_Class_Ord.op_Greater_Question uu___ x y in + if uu___4 then mem uu___ x b else true) +let rec elems : 'a . 'a rbset -> 'a Prims.list = + fun s -> + match s with + | L -> [] + | N (uu___, a1, x, b) -> + let uu___1 = elems a1 in + let uu___2 = + let uu___3 = elems b in FStar_List_Tot_Base.append [x] uu___3 in + FStar_List_Tot_Base.append uu___1 uu___2 +let equal : 'a . 'a FStar_Class_Ord.ord -> 'a rbset -> 'a rbset -> Prims.bool + = + fun uu___ -> + fun s1 -> + fun s2 -> + let uu___1 = elems s1 in + let uu___2 = elems s2 in + FStar_Class_Deq.op_Equals_Question + (FStar_Class_Ord.ord_eq (FStar_Class_Ord.ord_list uu___)) uu___1 + uu___2 +let rec union : + 'a . 'a FStar_Class_Ord.ord -> 'a rbset -> 'a rbset -> 'a rbset = + fun uu___ -> + fun s1 -> + fun s2 -> + match s1 with + | L -> s2 + | N (c, a1, x, b) -> + let uu___1 = let uu___2 = add uu___ x s2 in union uu___ b uu___2 in + union uu___ a1 uu___1 +let inter : 'a . 'a FStar_Class_Ord.ord -> 'a rbset -> 'a rbset -> 'a rbset = + fun uu___ -> + fun s1 -> + fun s2 -> + let rec aux s11 acc = + match s11 with + | L -> acc + | N (uu___1, a1, x, b) -> + let uu___2 = mem uu___ x s2 in + if uu___2 + then + let uu___3 = let uu___4 = aux b acc in aux a1 uu___4 in + add uu___ x uu___3 + else (let uu___4 = aux b acc in aux a1 uu___4) in + aux s1 L +let rec diff : + 'a . 'a FStar_Class_Ord.ord -> 'a rbset -> 'a rbset -> 'a rbset = + fun uu___ -> + fun s1 -> + fun s2 -> + match s2 with + | L -> s1 + | N (uu___1, a1, x, b) -> + let uu___2 = + let uu___3 = remove uu___ x s1 in diff uu___ uu___3 a1 in + diff uu___ uu___2 b +let rec subset : + 'a . 'a FStar_Class_Ord.ord -> 'a rbset -> 'a rbset -> Prims.bool = + fun uu___ -> + fun s1 -> + fun s2 -> + match s1 with + | L -> true + | N (uu___1, a1, x, b) -> + ((mem uu___ x s2) && (subset uu___ a1 s2)) && (subset uu___ b s2) +let rec for_all : 'a . ('a -> Prims.bool) -> 'a rbset -> Prims.bool = + fun p -> + fun s -> + match s with + | L -> true + | N (uu___, a1, x, b) -> ((p x) && (for_all p a1)) && (for_all p b) +let rec for_any : 'a . ('a -> Prims.bool) -> 'a rbset -> Prims.bool = + fun p -> + fun s -> + match s with + | L -> false + | N (uu___, a1, x, b) -> ((p x) || (for_any p a1)) || (for_any p b) +let from_list : 'a . 'a FStar_Class_Ord.ord -> 'a Prims.list -> 'a rbset = + fun uu___ -> + fun xs -> + FStar_Compiler_List.fold_left (fun s -> fun e -> add uu___ e s) L xs +let addn : + 'a . 'a FStar_Class_Ord.ord -> 'a Prims.list -> 'a rbset -> 'a rbset = + fun uu___ -> + fun xs -> + fun s -> + FStar_Compiler_List.fold_left (fun s1 -> fun e -> add uu___ e s1) s + xs +let collect : + 'a . + 'a FStar_Class_Ord.ord -> ('a -> 'a rbset) -> 'a Prims.list -> 'a rbset + = + fun uu___ -> + fun f -> + fun l -> + FStar_Compiler_List.fold_left + (fun s -> fun e -> let uu___1 = f e in union uu___ uu___1 s) L l +let setlike_rbset : + 'a . 'a FStar_Class_Ord.ord -> ('a, 'a t) FStar_Class_Setlike.setlike = + fun uu___ -> + { + FStar_Class_Setlike.empty = empty; + FStar_Class_Setlike.singleton = singleton; + FStar_Class_Setlike.is_empty = (is_empty ()); + FStar_Class_Setlike.add = (add uu___); + FStar_Class_Setlike.remove = (remove uu___); + FStar_Class_Setlike.mem = (mem uu___); + FStar_Class_Setlike.equal = (equal uu___); + FStar_Class_Setlike.subset = (subset uu___); + FStar_Class_Setlike.union = (union uu___); + FStar_Class_Setlike.inter = (inter uu___); + FStar_Class_Setlike.diff = (diff uu___); + FStar_Class_Setlike.for_all = for_all; + FStar_Class_Setlike.for_any = for_any; + FStar_Class_Setlike.elems = elems; + FStar_Class_Setlike.collect = (collect uu___); + FStar_Class_Setlike.from_list = (from_list uu___); + FStar_Class_Setlike.addn = (addn uu___) + } \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Compiler_Set.ml b/ocaml/fstar-lib/generated/FStar_Compiler_Set.ml deleted file mode 100644 index 224379a4f80..00000000000 --- a/ocaml/fstar-lib/generated/FStar_Compiler_Set.ml +++ /dev/null @@ -1,112 +0,0 @@ -open Prims -type 't set = 't Prims.list -type 'a t = 'a set -let rec add : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a set -> 'a set = - fun uu___ -> - fun x -> - fun s -> - match s with - | [] -> [x] - | y::yy -> - let uu___1 = - FStar_Class_Deq.op_Equals_Question - (FStar_Class_Ord.ord_eq uu___) x y in - if uu___1 - then s - else (let uu___3 = add uu___ x yy in y :: uu___3) -let empty : 'a . 'a FStar_Class_Ord.ord -> unit -> 'a set = - fun uu___ -> fun uu___1 -> [] -let from_list : 'a . 'a FStar_Class_Ord.ord -> 'a Prims.list -> 'a set = - fun uu___ -> fun xs -> FStar_Class_Ord.dedup uu___ xs -let mem : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a set -> Prims.bool = - fun uu___ -> - fun x -> - fun s -> - FStar_Compiler_List.existsb - (fun y -> - FStar_Class_Deq.op_Equals_Question - (FStar_Class_Ord.ord_eq uu___) x y) s -let singleton : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a set = - fun uu___ -> fun x -> [x] -let is_empty : 'a . 'a FStar_Class_Ord.ord -> 'a set -> Prims.bool = - fun uu___ -> fun s -> Prims.uu___is_Nil s -let addn : 'a . 'a FStar_Class_Ord.ord -> 'a Prims.list -> 'a set -> 'a set = - fun uu___ -> - fun xs -> fun ys -> FStar_Compiler_List.fold_right (add uu___) xs ys -let rec remove : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a set -> 'a set = - fun uu___ -> - fun x -> - fun s -> - match s with - | [] -> [] - | y::yy -> - let uu___1 = - FStar_Class_Deq.op_Equals_Question - (FStar_Class_Ord.ord_eq uu___) x y in - if uu___1 - then yy - else (let uu___3 = remove uu___ x yy in y :: uu___3) -let elems : 'a . 'a FStar_Class_Ord.ord -> 'a set -> 'a Prims.list = - fun uu___ -> fun s -> s -let for_all : - 'a . 'a FStar_Class_Ord.ord -> ('a -> Prims.bool) -> 'a set -> Prims.bool = - fun uu___ -> - fun p -> - fun s -> - let uu___1 = elems uu___ s in FStar_Compiler_List.for_all p uu___1 -let for_any : - 'a . 'a FStar_Class_Ord.ord -> ('a -> Prims.bool) -> 'a set -> Prims.bool = - fun uu___ -> - fun p -> - fun s -> - let uu___1 = elems uu___ s in FStar_Compiler_List.existsb p uu___1 -let subset : 'a . 'a FStar_Class_Ord.ord -> 'a set -> 'a set -> Prims.bool = - fun uu___ -> fun s1 -> fun s2 -> for_all uu___ (fun y -> mem uu___ y s2) s1 -let equal : 'a . 'a FStar_Class_Ord.ord -> 'a set -> 'a set -> Prims.bool = - fun uu___ -> - fun s1 -> - fun s2 -> - let uu___1 = FStar_Class_Ord.sort uu___ s1 in - let uu___2 = FStar_Class_Ord.sort uu___ s2 in - FStar_Class_Deq.op_Equals_Question - (FStar_Class_Ord.ord_eq (FStar_Class_Ord.ord_list uu___)) uu___1 - uu___2 -let union : 'a . 'a FStar_Class_Ord.ord -> 'a set -> 'a set -> 'a set = - fun uu___ -> - fun s1 -> - fun s2 -> - FStar_Compiler_List.fold_left (fun s -> fun x -> add uu___ x s) s1 s2 -let inter : 'a . 'a FStar_Class_Ord.ord -> 'a set -> 'a set -> 'a set = - fun uu___ -> - fun s1 -> - fun s2 -> FStar_Compiler_List.filter (fun y -> mem uu___ y s2) s1 -let diff : 'a . 'a FStar_Class_Ord.ord -> 'a set -> 'a set -> 'a set = - fun uu___ -> - fun s1 -> - fun s2 -> - FStar_Compiler_List.filter - (fun y -> let uu___1 = mem uu___ y s2 in Prims.op_Negation uu___1) - s1 -let collect : - 'a 'b . 'b FStar_Class_Ord.ord -> ('a -> 'b set) -> 'a Prims.list -> 'b set - = - fun uu___ -> - fun f -> - fun l -> - let uu___1 = empty uu___ () in - FStar_Compiler_List.fold_right - (fun x -> fun acc -> let uu___2 = f x in union uu___ uu___2 acc) l - uu___1 -let showable_set : - 'a . - 'a FStar_Class_Ord.ord -> - 'a FStar_Class_Show.showable -> 'a set FStar_Class_Show.showable - = - fun uu___ -> - fun uu___1 -> - { - FStar_Class_Show.show = - (fun s -> - let uu___2 = elems uu___ s in - FStar_Class_Show.show (FStar_Class_Show.show_list uu___1) uu___2) - } \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Defensive.ml b/ocaml/fstar-lib/generated/FStar_Defensive.ml index 2f456ecca1d..87160bf072b 100644 --- a/ocaml/fstar-lib/generated/FStar_Defensive.ml +++ b/ocaml/fstar-lib/generated/FStar_Defensive.ml @@ -10,7 +10,7 @@ let pp_set : 'a . 'a FStar_Class_Ord.ord -> 'a FStar_Class_PP.pretty -> - 'a FStar_Compiler_Set.set FStar_Class_PP.pretty + 'a FStar_Compiler_FlatSet.t FStar_Class_PP.pretty = fun uu___ -> fun uu___1 -> @@ -26,7 +26,10 @@ let pp_set : Prims.int_zero uu___2 FStar_Pprint.lbracket uu___3 FStar_Pprint.rbracket ds in let uu___2 = - let uu___3 = FStar_Compiler_Set.elems uu___ s in + let uu___3 = + FStar_Class_Setlike.elems () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set uu___)) + (Obj.magic s) in FStar_Compiler_List.map (FStar_Class_PP.pp uu___1) uu___3 in doclist uu___2) } @@ -49,8 +52,11 @@ let __def_check_scoped : let scope = FStar_Class_Binders.boundNames uu___ env in let uu___3 = let uu___4 = - FStar_Compiler_Set.subset FStar_Syntax_Syntax.ord_bv free - scope in + FStar_Class_Setlike.subset () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) (Obj.magic free) + (Obj.magic scope) in Prims.op_Negation uu___4 in if uu___3 then @@ -90,8 +96,12 @@ let __def_check_scoped : let uu___15 = FStar_Errors_Msg.text "Diff =" in let uu___16 = let uu___17 = - FStar_Compiler_Set.diff - FStar_Syntax_Syntax.ord_bv free scope in + Obj.magic + (FStar_Class_Setlike.diff () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic free) (Obj.magic scope)) in FStar_Class_PP.pp (pp_set FStar_Syntax_Syntax.ord_bv pp_bv) uu___17 in diff --git a/ocaml/fstar-lib/generated/FStar_Extraction_ML_RemoveUnusedParameters.ml b/ocaml/fstar-lib/generated/FStar_Extraction_ML_RemoveUnusedParameters.ml index 543896ed1d2..39ad27ac71f 100644 --- a/ocaml/fstar-lib/generated/FStar_Extraction_ML_RemoveUnusedParameters.ml +++ b/ocaml/fstar-lib/generated/FStar_Extraction_ML_RemoveUnusedParameters.ml @@ -45,24 +45,40 @@ let (lookup_tyname : fun name -> let uu___ = FStar_Extraction_ML_Syntax.string_of_mlpath name in FStar_Compiler_Util.psmap_try_find env.tydef_map uu___ -type var_set = FStar_Extraction_ML_Syntax.mlident FStar_Compiler_Set.set -let (empty_var_set : Prims.string FStar_Compiler_Set.set) = - FStar_Compiler_Set.empty FStar_Class_Ord.ord_string () +type var_set = FStar_Extraction_ML_Syntax.mlident FStar_Compiler_RBSet.t +let (empty_var_set : Prims.string FStar_Compiler_RBSet.t) = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset FStar_Class_Ord.ord_string)) ()) let rec (freevars_of_mlty' : var_set -> FStar_Extraction_ML_Syntax.mlty -> var_set) = - fun vars -> - fun t -> - match t with - | FStar_Extraction_ML_Syntax.MLTY_Var i -> - FStar_Compiler_Set.add FStar_Class_Ord.ord_string i vars - | FStar_Extraction_ML_Syntax.MLTY_Fun (t0, uu___, t1) -> - let uu___1 = freevars_of_mlty' vars t0 in - freevars_of_mlty' uu___1 t1 - | FStar_Extraction_ML_Syntax.MLTY_Named (tys, uu___) -> - FStar_Compiler_List.fold_left freevars_of_mlty' vars tys - | FStar_Extraction_ML_Syntax.MLTY_Tuple tys -> - FStar_Compiler_List.fold_left freevars_of_mlty' vars tys - | uu___ -> vars + fun uu___1 -> + fun uu___ -> + (fun vars -> + fun t -> + match t with + | FStar_Extraction_ML_Syntax.MLTY_Var i -> + Obj.magic + (Obj.repr + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_string)) i (Obj.magic vars))) + | FStar_Extraction_ML_Syntax.MLTY_Fun (t0, uu___, t1) -> + Obj.magic + (Obj.repr + (let uu___1 = freevars_of_mlty' vars t0 in + freevars_of_mlty' uu___1 t1)) + | FStar_Extraction_ML_Syntax.MLTY_Named (tys, uu___) -> + Obj.magic + (Obj.repr + (FStar_Compiler_List.fold_left freevars_of_mlty' vars tys)) + | FStar_Extraction_ML_Syntax.MLTY_Tuple tys -> + Obj.magic + (Obj.repr + (FStar_Compiler_List.fold_left freevars_of_mlty' vars tys)) + | uu___ -> Obj.magic (Obj.repr vars)) uu___1 uu___ let (freevars_of_mlty : FStar_Extraction_ML_Syntax.mlty -> var_set) = freevars_of_mlty' empty_var_set let rec (elim_mlty : @@ -327,8 +343,11 @@ let (elim_tydef : let p = param.FStar_Extraction_ML_Syntax.ty_param_name in let uu___2 = - FStar_Compiler_Set.mem FStar_Class_Ord.ord_string - p freevars in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_string)) p + (Obj.magic freevars) in if uu___2 then (if must_eliminate i diff --git a/ocaml/fstar-lib/generated/FStar_Interactive_Ide.ml b/ocaml/fstar-lib/generated/FStar_Interactive_Ide.ml index 96c7b622e87..b6d7f0360c3 100644 --- a/ocaml/fstar-lib/generated/FStar_Interactive_Ide.ml +++ b/ocaml/fstar-lib/generated/FStar_Interactive_Ide.ml @@ -2444,7 +2444,7 @@ type search_candidate = FStar_Compiler_Effect.ref ; sc_fvars: - FStar_Ident.lid FStar_Compiler_Set.t FStar_Pervasives_Native.option + FStar_Ident.lid FStar_Compiler_RBSet.t FStar_Pervasives_Native.option FStar_Compiler_Effect.ref } let (__proj__Mksearch_candidate__item__sc_lid : @@ -2460,7 +2460,7 @@ let (__proj__Mksearch_candidate__item__sc_typ : match projectee with | { sc_lid; sc_typ; sc_fvars;_} -> sc_typ let (__proj__Mksearch_candidate__item__sc_fvars : search_candidate -> - FStar_Ident.lid FStar_Compiler_Set.t FStar_Pervasives_Native.option + FStar_Ident.lid FStar_Compiler_RBSet.t FStar_Pervasives_Native.option FStar_Compiler_Effect.ref) = fun projectee -> @@ -2490,7 +2490,7 @@ let (sc_typ : typ) let (sc_fvars : FStar_TypeChecker_Env.env -> - search_candidate -> FStar_Ident.lident FStar_Compiler_Set.set) + search_candidate -> FStar_Ident.lident FStar_Compiler_RBSet.t) = fun tcenv -> fun sc -> @@ -2539,7 +2539,6 @@ let run_search : fun st -> fun search_str -> let tcenv = st.FStar_Interactive_Ide_Types.repl_env in - let empty_fv_set = FStar_Syntax_Syntax.new_fv_set () in let st_matches candidate term = let found = match term.st_term with @@ -2548,7 +2547,10 @@ let run_search : FStar_Compiler_Util.contains uu___ str | TypeContainsLid lid -> let uu___ = sc_fvars tcenv candidate in - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_fv lid uu___ in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_fv)) lid (Obj.magic uu___) in found <> term.st_negate in let parse search_str1 = let parse_one term = diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml index ec50ccf9f2f..d1348d87f7e 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml @@ -385,10 +385,17 @@ let check_pattern_vars : let pat_vars = let uu___ = FStar_Syntax_Free.names hd in FStar_Compiler_List.fold_left - (fun out -> - fun x -> - let uu___1 = FStar_Syntax_Free.names x in - FStar_Compiler_Set.union FStar_Syntax_Syntax.ord_bv out + (fun uu___2 -> + fun uu___1 -> + (fun out -> + fun x -> + let uu___1 = FStar_Syntax_Free.names x in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic out) (Obj.magic uu___1))) uu___2 uu___1) uu___ tl in let uu___ = FStar_Compiler_Util.find_opt @@ -399,8 +406,11 @@ let check_pattern_vars : FStar_Syntax_Syntax.binder_positivity = uu___3; FStar_Syntax_Syntax.binder_attrs = uu___4;_} -> let uu___5 = - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv b - pat_vars in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) b + (Obj.magic pat_vars) in Prims.op_Negation uu___5) vars in (match uu___ with | FStar_Pervasives_Native.None -> () @@ -1854,8 +1864,11 @@ and (encode_term : let uu___5 = let fvs = let uu___6 = FStar_Syntax_Free.names t0 in - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_bv - uu___6 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic uu___6) in let getfreeV t2 = match t2.FStar_SMTEncoding_Term.tm with | FStar_SMTEncoding_Term.FreeV fv -> fv @@ -2650,8 +2663,11 @@ and (encode_term : let uu___4 = let fvs = let uu___5 = FStar_Syntax_Free.names t0 in - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_bv - uu___5 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic uu___5) in let tms = FStar_Compiler_List.map (FStar_SMTEncoding_Env.lookup_term_var env) fvs in diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml index 99e85a2c75b..ddfeca71d0c 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml @@ -532,12 +532,17 @@ let (fv_eq : fv -> fv -> Prims.bool) = let (fvs_subset_of : fvs -> fvs -> Prims.bool) = fun x -> fun y -> - let cmp_fv x1 y1 = - let uu___ = fv_name x1 in - let uu___1 = fv_name y1 in FStar_Compiler_Util.compare uu___ uu___1 in - let uu___ = FStar_Compiler_Set.from_list ord_fv x in - let uu___1 = FStar_Compiler_Set.from_list ord_fv y in - FStar_Compiler_Set.subset ord_fv uu___ uu___1 + let uu___ = + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic (FStar_Compiler_RBSet.setlike_rbset ord_fv)) x) in + let uu___1 = + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic (FStar_Compiler_RBSet.setlike_rbset ord_fv)) y) in + FStar_Class_Setlike.subset () + (Obj.magic (FStar_Compiler_RBSet.setlike_rbset ord_fv)) + (Obj.magic uu___) (Obj.magic uu___1) let (freevar_eq : term -> term -> Prims.bool) = fun x -> fun y -> diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml b/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml index 821d2993eee..06ff38992f3 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml @@ -96,7 +96,7 @@ let (uu___is_Record_or_dc : scope_mod -> Prims.bool) = match projectee with | Record_or_dc _0 -> true | uu___ -> false let (__proj__Record_or_dc__item___0 : scope_mod -> record_or_dc) = fun projectee -> match projectee with | Record_or_dc _0 -> _0 -type string_set = Prims.string FStar_Compiler_Set.t +type string_set = Prims.string FStar_Compiler_RBSet.t type exported_id_kind = | Exported_id_term_type | Exported_id_field @@ -400,7 +400,10 @@ let (transitive_exported_ids : let uu___1 = let uu___2 = exported_id_set1 Exported_id_term_type in FStar_Compiler_Effect.op_Bang uu___2 in - FStar_Compiler_Set.elems FStar_Class_Ord.ord_string uu___1 + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset FStar_Class_Ord.ord_string)) + (Obj.magic uu___1) let (opens_and_abbrevs : env -> (FStar_Syntax_Syntax.open_module_or_namespace, @@ -784,8 +787,11 @@ let find_in_module_with_includes : let mexports = let uu___2 = mex eikind in FStar_Compiler_Effect.op_Bang uu___2 in - FStar_Compiler_Set.mem FStar_Class_Ord.ord_string - idstr mexports in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_string)) idstr + (Obj.magic mexports) in let mincludes = let uu___1 = FStar_Compiler_Util.smap_try_find env1.includes mname in @@ -2185,9 +2191,15 @@ let (extract_record : let uu___31 = FStar_Compiler_Effect.op_Bang my_exported_ids in - FStar_Compiler_Set.add - FStar_Class_Ord.ord_string - uu___30 uu___31 in + Obj.magic + (FStar_Class_Setlike.add + () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_string)) + uu___30 + (Obj.magic + uu___31)) in FStar_Compiler_Effect.op_Colon_Equals my_exported_ids uu___29); @@ -2208,10 +2220,17 @@ let (extract_record : let uu___31 = FStar_Compiler_Effect.op_Bang my_exported_ids in - FStar_Compiler_Set.add - FStar_Class_Ord.ord_string - projname - uu___31 in + Obj.magic + (FStar_Class_Setlike.add + () + ( + Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_string)) + projname + ( + Obj.magic + uu___31)) in FStar_Compiler_Effect.op_Colon_Equals my_exported_ids uu___30)) @@ -2322,16 +2341,17 @@ let (try_lookup_dc_by_field_name : (uu___2, (r.is_record)) in FStar_Pervasives_Native.Some uu___1 | uu___1 -> FStar_Pervasives_Native.None -let (string_set_ref_new : - unit -> Prims.string FStar_Compiler_Set.t FStar_Compiler_Effect.ref) = +let (string_set_ref_new : unit -> string_set FStar_Compiler_Effect.ref) = fun uu___ -> - let uu___1 = FStar_Compiler_Set.empty FStar_Class_Ord.ord_string () in + let uu___1 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset FStar_Class_Ord.ord_string)) + ()) in FStar_Compiler_Util.mk_ref uu___1 let (exported_id_set_new : - unit -> - exported_id_kind -> - Prims.string FStar_Compiler_Set.t FStar_Compiler_Effect.ref) - = + unit -> exported_id_kind -> string_set FStar_Compiler_Effect.ref) = fun uu___ -> let term_type_set = string_set_ref_new () in let field_set = string_set_ref_new () in @@ -2590,9 +2610,12 @@ let (push_sigelt' : Prims.bool -> env -> FStar_Syntax_Syntax.sigelt -> env) = let uu___8 = FStar_Compiler_Effect.op_Bang my_exported_ids in - FStar_Compiler_Set.add - FStar_Class_Ord.ord_string uu___7 - uu___8 in + Obj.magic + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_string)) + uu___7 (Obj.magic uu___8)) in FStar_Compiler_Effect.op_Colon_Equals my_exported_ids uu___6 | FStar_Pervasives_Native.None -> ()); @@ -2724,8 +2747,12 @@ let (push_include : env -> FStar_Ident.lident -> env) = (let uu___7 = let uu___8 = FStar_Compiler_Effect.op_Bang ex in - FStar_Compiler_Set.diff - FStar_Class_Ord.ord_string uu___8 ns_ex in + Obj.magic + (FStar_Class_Setlike.diff () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_string)) + (Obj.magic uu___8) (Obj.magic ns_ex)) in FStar_Compiler_Effect.op_Colon_Equals ex uu___7); (match () with @@ -2734,9 +2761,13 @@ let (push_include : env -> FStar_Ident.lident -> env) = let uu___8 = let uu___9 = FStar_Compiler_Effect.op_Bang trans_ex in - FStar_Compiler_Set.union - FStar_Class_Ord.ord_string uu___9 - ns_ex in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_string)) + (Obj.magic uu___9) + (Obj.magic ns_ex)) in FStar_Compiler_Effect.op_Colon_Equals trans_ex uu___8) in FStar_Compiler_List.iter update_exports @@ -3032,8 +3063,12 @@ let (finish : env -> FStar_Syntax_Syntax.modul -> env) = let uu___3 = let uu___4 = FStar_Compiler_Effect.op_Bang cur_trans_ex_set_ref in - FStar_Compiler_Set.union FStar_Class_Ord.ord_string - cur_ex_set uu___4 in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_string)) + (Obj.magic cur_ex_set) (Obj.magic uu___4)) in FStar_Compiler_Effect.op_Colon_Equals cur_trans_ex_set_ref uu___3 in FStar_Compiler_List.iter update_exports all_exported_id_kinds @@ -3169,50 +3204,36 @@ let (finish_module_or_interface : let uu___ = finish env1 modul1 in (uu___, modul1) type exported_ids = { - exported_id_terms: Prims.string Prims.list ; - exported_id_fields: Prims.string Prims.list } + exported_id_terms: string_set ; + exported_id_fields: string_set } let (__proj__Mkexported_ids__item__exported_id_terms : - exported_ids -> Prims.string Prims.list) = + exported_ids -> string_set) = fun projectee -> match projectee with | { exported_id_terms; exported_id_fields;_} -> exported_id_terms let (__proj__Mkexported_ids__item__exported_id_fields : - exported_ids -> Prims.string Prims.list) = + exported_ids -> string_set) = fun projectee -> match projectee with | { exported_id_terms; exported_id_fields;_} -> exported_id_fields let (as_exported_ids : exported_id_set -> exported_ids) = fun e -> let terms = - let uu___ = - let uu___1 = e Exported_id_term_type in - FStar_Compiler_Effect.op_Bang uu___1 in - FStar_Compiler_Set.elems FStar_Class_Ord.ord_string uu___ in + let uu___ = e Exported_id_term_type in + FStar_Compiler_Effect.op_Bang uu___ in let fields = - let uu___ = - let uu___1 = e Exported_id_field in - FStar_Compiler_Effect.op_Bang uu___1 in - FStar_Compiler_Set.elems FStar_Class_Ord.ord_string uu___ in + let uu___ = e Exported_id_field in FStar_Compiler_Effect.op_Bang uu___ in { exported_id_terms = terms; exported_id_fields = fields } let (as_exported_id_set : exported_ids FStar_Pervasives_Native.option -> - exported_id_kind -> - Prims.string FStar_Compiler_Set.t FStar_Compiler_Effect.ref) + exported_id_kind -> string_set FStar_Compiler_Effect.ref) = fun e -> match e with | FStar_Pervasives_Native.None -> exported_id_set_new () | FStar_Pervasives_Native.Some e1 -> - let terms = - let uu___ = - FStar_Compiler_Set.from_list FStar_Class_Ord.ord_string - e1.exported_id_terms in - FStar_Compiler_Util.mk_ref uu___ in - let fields = - let uu___ = - FStar_Compiler_Set.from_list FStar_Class_Ord.ord_string - e1.exported_id_fields in - FStar_Compiler_Util.mk_ref uu___ in + let terms = FStar_Compiler_Util.mk_ref e1.exported_id_terms in + let fields = FStar_Compiler_Util.mk_ref e1.exported_id_fields in (fun uu___ -> match uu___ with | Exported_id_term_type -> terms diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml index 29953fecb10..a8e1153d82c 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml @@ -85,7 +85,7 @@ let (uu___is_NoCache : use_cache_t -> Prims.bool) = let (uu___is_Full : use_cache_t -> Prims.bool) = fun projectee -> match projectee with | Full -> true | uu___ -> false type free_vars_and_fvars = - (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident FStar_Compiler_Set.set) + (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident FStar_Compiler_RBSet.t) let rec snoc : 'a . 'a FStar_Class_Deq.deq -> 'a Prims.list -> 'a -> 'a Prims.list = fun uu___ -> @@ -107,30 +107,39 @@ let op_At_At : fun ys -> FStar_Compiler_List.fold_left (fun xs1 -> fun y -> snoc uu___ xs1 y) xs ys -let (no_free_vars : - (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident FStar_Compiler_Set.t)) - = - let uu___ = FStar_Syntax_Syntax.new_fv_set () in +let (no_free_vars : free_vars_and_fvars) = + let uu___ = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset FStar_Syntax_Syntax.ord_fv)) + ()) in ({ FStar_Syntax_Syntax.free_names = []; FStar_Syntax_Syntax.free_uvars = []; FStar_Syntax_Syntax.free_univs = []; FStar_Syntax_Syntax.free_univ_names = [] }, uu___) -let (singleton_fvar : - FStar_Syntax_Syntax.fv -> - (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident - FStar_Compiler_Set.set)) - = +let (singleton_fvar : FStar_Syntax_Syntax.fv -> free_vars_and_fvars) = fun fv -> let uu___ = - let uu___1 = FStar_Syntax_Syntax.new_fv_set () in - FStar_Compiler_Set.add FStar_Syntax_Syntax.ord_fv - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v uu___1 in + let uu___1 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_fv)) ()) in + Obj.magic + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset FStar_Syntax_Syntax.ord_fv)) + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v + (Obj.magic uu___1)) in ((FStar_Pervasives_Native.fst no_free_vars), uu___) let (singleton_bv : FStar_Syntax_Syntax.bv -> - (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident FStar_Compiler_Set.t)) + (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident + FStar_Compiler_RBSet.t)) = fun x -> ((let uu___ = FStar_Pervasives_Native.fst no_free_vars in @@ -145,7 +154,8 @@ let (singleton_bv : }), (FStar_Pervasives_Native.snd no_free_vars)) let (singleton_uv : FStar_Syntax_Syntax.ctx_uvar -> - (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident FStar_Compiler_Set.t)) + (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident + FStar_Compiler_RBSet.t)) = fun x -> ((let uu___ = FStar_Pervasives_Native.fst no_free_vars in @@ -160,7 +170,8 @@ let (singleton_uv : }), (FStar_Pervasives_Native.snd no_free_vars)) let (singleton_univ : FStar_Syntax_Syntax.universe_uvar -> - (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident FStar_Compiler_Set.t)) + (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident + FStar_Compiler_RBSet.t)) = fun x -> ((let uu___ = FStar_Pervasives_Native.fst no_free_vars in @@ -175,7 +186,8 @@ let (singleton_univ : }), (FStar_Pervasives_Native.snd no_free_vars)) let (singleton_univ_name : FStar_Syntax_Syntax.univ_name -> - (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident FStar_Compiler_Set.t)) + (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident + FStar_Compiler_RBSet.t)) = fun x -> ((let uu___ = FStar_Pervasives_Native.fst no_free_vars in @@ -192,7 +204,7 @@ let (union : free_vars_and_fvars -> free_vars_and_fvars -> (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident - FStar_Compiler_Set.set)) + FStar_Compiler_RBSet.t)) = fun f1 -> fun f2 -> @@ -220,8 +232,13 @@ let (union : FStar_Syntax_Syntax.free_univ_names = uu___4 } in let uu___1 = - FStar_Compiler_Set.union FStar_Syntax_Syntax.ord_fv - (FStar_Pervasives_Native.snd f1) (FStar_Pervasives_Native.snd f2) in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_fv)) + (Obj.magic (FStar_Pervasives_Native.snd f1)) + (Obj.magic (FStar_Pervasives_Native.snd f2))) in (uu___, uu___1) let rec (free_univs : FStar_Syntax_Syntax.universe -> free_vars_and_fvars) = fun u -> @@ -436,7 +453,13 @@ and (free_names_and_uvars : | FStar_Pervasives_Native.Some n when let uu___1 = should_invalidate_cache n use_cache in Prims.op_Negation uu___1 -> - let uu___1 = FStar_Syntax_Syntax.new_fv_set () in (n, uu___1) + let uu___1 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_fv)) ()) in + (n, uu___1) | uu___1 -> (FStar_Compiler_Effect.op_Colon_Equals t1.FStar_Syntax_Syntax.vars FStar_Pervasives_Native.None; @@ -451,12 +474,7 @@ and (free_names_and_uvars : and (free_names_and_uvars_args : (FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax * FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option) - Prims.list -> - (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident - FStar_Compiler_Set.set) -> - use_cache_t -> - (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident - FStar_Compiler_Set.set)) + Prims.list -> free_vars_and_fvars -> use_cache_t -> free_vars_and_fvars) = fun args -> fun acc -> @@ -484,7 +502,13 @@ and (free_names_and_uvars_comp : FStar_Pervasives_Native.None; free_names_and_uvars_comp c use_cache) else - (let uu___3 = FStar_Syntax_Syntax.new_fv_set () in (n, uu___3)) + (let uu___3 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_fv)) ()) in + (n, uu___3)) | uu___1 -> let n = match c.FStar_Syntax_Syntax.n with @@ -555,102 +579,132 @@ and (should_invalidate_cache : | FStar_Pervasives_Native.Some uu___1 -> true | FStar_Pervasives_Native.None -> false) n.FStar_Syntax_Syntax.free_univs) -let (new_uv_set : unit -> FStar_Syntax_Syntax.uvars) = - fun uu___ -> FStar_Compiler_Set.empty ord_ctx_uvar () -let (new_universe_uvar_set : - unit -> FStar_Syntax_Syntax.universe_uvar FStar_Compiler_Set.set) = - fun uu___ -> FStar_Compiler_Set.empty ord_univ_uvar () -let (empty : FStar_Syntax_Syntax.bv FStar_Compiler_Set.set) = - FStar_Compiler_Set.empty FStar_Syntax_Syntax.ord_bv () let (names : - FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.set) + FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t) = - fun t -> - let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars t Def in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_names in - FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_bv uu___ + fun uu___ -> + (fun t -> + let uu___ = + let uu___1 = + let uu___2 = free_names_and_uvars t Def in + FStar_Pervasives_Native.fst uu___2 in + uu___1.FStar_Syntax_Syntax.free_names in + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) uu___)) uu___ let (uvars : FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.set) + FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_FlatSet.t) = - fun t -> - let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars t Def in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_uvars in - FStar_Compiler_Set.from_list ord_ctx_uvar uu___ + fun uu___ -> + (fun t -> + let uu___ = + let uu___1 = + let uu___2 = free_names_and_uvars t Def in + FStar_Pervasives_Native.fst uu___2 in + uu___1.FStar_Syntax_Syntax.free_uvars in + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_ctx_uvar)) + uu___)) uu___ let (univs : FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.universe_uvar FStar_Compiler_Set.set) + FStar_Syntax_Syntax.universe_uvar FStar_Compiler_FlatSet.t) = - fun t -> - let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars t Def in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_univs in - FStar_Compiler_Set.from_list ord_univ_uvar uu___ + fun uu___ -> + (fun t -> + let uu___ = + let uu___1 = + let uu___2 = free_names_and_uvars t Def in + FStar_Pervasives_Native.fst uu___2 in + uu___1.FStar_Syntax_Syntax.free_univs in + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set ord_univ_uvar)) uu___)) + uu___ let (univnames : FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.univ_name FStar_Compiler_Set.set) + FStar_Syntax_Syntax.univ_name FStar_Compiler_FlatSet.t) = - fun t -> - let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars t Def in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_univ_names in - FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_ident uu___ + fun uu___ -> + (fun t -> + let uu___ = + let uu___1 = + let uu___2 = free_names_and_uvars t Def in + FStar_Pervasives_Native.fst uu___2 in + uu___1.FStar_Syntax_Syntax.free_univ_names in + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) uu___)) uu___ let (univnames_comp : FStar_Syntax_Syntax.comp -> - FStar_Syntax_Syntax.univ_name FStar_Compiler_Set.set) + FStar_Syntax_Syntax.univ_name FStar_Compiler_FlatSet.t) = - fun c -> - let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars_comp c Def in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_univ_names in - FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_ident uu___ + fun uu___ -> + (fun c -> + let uu___ = + let uu___1 = + let uu___2 = free_names_and_uvars_comp c Def in + FStar_Pervasives_Native.fst uu___2 in + uu___1.FStar_Syntax_Syntax.free_univ_names in + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) uu___)) uu___ let (fvars : - FStar_Syntax_Syntax.term -> FStar_Ident.lident FStar_Compiler_Set.set) = + FStar_Syntax_Syntax.term -> FStar_Ident.lident FStar_Compiler_RBSet.t) = fun t -> let uu___ = free_names_and_uvars t NoCache in FStar_Pervasives_Native.snd uu___ let (names_of_binders : FStar_Syntax_Syntax.binders -> - FStar_Syntax_Syntax.bv FStar_Compiler_Set.set) + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t) = - fun bs -> - let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars_binders bs Def in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_names in - FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_bv uu___ + fun uu___ -> + (fun bs -> + let uu___ = + let uu___1 = + let uu___2 = free_names_and_uvars_binders bs Def in + FStar_Pervasives_Native.fst uu___2 in + uu___1.FStar_Syntax_Syntax.free_names in + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) uu___)) uu___ let (uvars_uncached : FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.set) + FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_FlatSet.t) = - fun t -> - let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars t NoCache in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_uvars in - FStar_Compiler_Set.from_list ord_ctx_uvar uu___ + fun uu___ -> + (fun t -> + let uu___ = + let uu___1 = + let uu___2 = free_names_and_uvars t NoCache in + FStar_Pervasives_Native.fst uu___2 in + uu___1.FStar_Syntax_Syntax.free_uvars in + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_ctx_uvar)) + uu___)) uu___ let (uvars_full : FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.set) + FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_FlatSet.t) = - fun t -> - let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars t Full in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_uvars in - FStar_Compiler_Set.from_list ord_ctx_uvar uu___ \ No newline at end of file + fun uu___ -> + (fun t -> + let uu___ = + let uu___1 = + let uu___2 = free_names_and_uvars t Full in + FStar_Pervasives_Native.fst uu___2 in + uu___1.FStar_Syntax_Syntax.free_uvars in + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_ctx_uvar)) + uu___)) uu___ \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Print_Pretty.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Print_Pretty.ml index dfce21d4754..5228d9ac5f6 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Print_Pretty.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Print_Pretty.ml @@ -138,7 +138,13 @@ let (pat_to_string : FStar_Syntax_Syntax.pat -> Prims.string) = FStar_GenSym.with_frozen_gensym (fun uu___ -> let e = - FStar_Syntax_Resugar.resugar_pat p FStar_Syntax_Syntax.no_names in + let uu___1 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) ()) in + FStar_Syntax_Resugar.resugar_pat p uu___1 in let d = FStar_Parser_ToDocument.pat_to_document e in pp d) let (binder_to_string' : Prims.bool -> FStar_Syntax_Syntax.binder -> Prims.string) = diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml index 5c4ec567b91..d9ea812baef 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml @@ -1999,7 +1999,7 @@ and (resugar_bv_as_pat' : FStar_Syntax_DsEnv.env -> FStar_Syntax_Syntax.bv -> FStar_Parser_AST.arg_qualifier FStar_Pervasives_Native.option -> - FStar_Syntax_Syntax.bv FStar_Compiler_Set.set -> + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t -> FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax FStar_Pervasives_Native.option -> FStar_Parser_AST.pattern) = @@ -2012,7 +2012,10 @@ and (resugar_bv_as_pat' : let uu___ = FStar_Syntax_Syntax.range_of_bv v in FStar_Parser_AST.mk_pattern a uu___ in let used = - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv v body_bv in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) v (Obj.magic body_bv) in let pat = let uu___ = if used @@ -2047,7 +2050,7 @@ and (resugar_bv_as_pat : FStar_Syntax_DsEnv.env -> FStar_Syntax_Syntax.bv -> FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> - FStar_Syntax_Syntax.bv FStar_Compiler_Set.set -> + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t -> FStar_Parser_AST.pattern FStar_Pervasives_Native.option) = fun env -> @@ -2065,7 +2068,8 @@ and (resugar_bv_as_pat : and (resugar_pat' : FStar_Syntax_DsEnv.env -> FStar_Syntax_Syntax.pat -> - FStar_Syntax_Syntax.bv FStar_Compiler_Set.t -> FStar_Parser_AST.pattern) + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t -> + FStar_Parser_AST.pattern) = fun env -> fun p -> @@ -2088,8 +2092,11 @@ and (resugar_pat' : let might_be_used = match pattern.FStar_Syntax_Syntax.v with | FStar_Syntax_Syntax.Pat_var bv -> - FStar_Compiler_Set.mem - FStar_Syntax_Syntax.ord_bv bv branch_bv + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) bv + (Obj.magic branch_bv) | uu___2 -> true in is_implicit && might_be_used) args in Prims.op_Negation uu___) in @@ -3088,7 +3095,8 @@ let (resugar_comp : FStar_Syntax_Syntax.comp -> FStar_Parser_AST.term) = fun c -> let uu___ = noenv resugar_comp' in uu___ c let (resugar_pat : FStar_Syntax_Syntax.pat -> - FStar_Syntax_Syntax.bv FStar_Compiler_Set.t -> FStar_Parser_AST.pattern) + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t -> + FStar_Parser_AST.pattern) = fun p -> fun branch_bv -> let uu___ = noenv resugar_pat' in uu___ p branch_bv diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml index 7d4ac317960..35276ce22c0 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml @@ -1128,7 +1128,7 @@ type term = term' syntax type uvar = ((term' syntax FStar_Pervasives_Native.option * uvar_decoration) FStar_Unionfind.p_uvar * version * FStar_Compiler_Range_Type.range) -type uvars = ctx_uvar FStar_Compiler_Set.t +type uvars = ctx_uvar FStar_Compiler_FlatSet.t type comp = comp' syntax type ascription = ((term' syntax, comp' syntax) FStar_Pervasives.either * term' syntax @@ -1149,7 +1149,7 @@ type args = type binders = binder Prims.list type lbname = (bv, fv) FStar_Pervasives.either type letbindings = (Prims.bool * letbinding Prims.list) -type freenames = bv FStar_Compiler_Set.t +type freenames = bv FStar_Compiler_FlatSet.t type attribute = term' syntax type tscheme = (univ_name Prims.list * term' syntax) type gamma = binding Prims.list @@ -2278,6 +2278,8 @@ let (lookup_aq : bv -> antiquotations -> term) = + (FStar_Pervasives_Native.fst aq))) () with | uu___ -> FStar_Compiler_Effect.failwith "antiquotation out of bounds" +type path = Prims.string Prims.list +type subst_t = subst_elt Prims.list let deq_instance_from_cmp : 'uuuuu . ('uuuuu -> 'uuuuu -> FStar_Compiler_Order.order) -> @@ -2360,24 +2362,11 @@ let mk_uvs : 'uuuuu . unit -> 'uuuuu FStar_Pervasives_Native.option FStar_Compiler_Effect.ref = fun uu___ -> FStar_Compiler_Util.mk_ref FStar_Pervasives_Native.None -let (new_bv_set : unit -> bv FStar_Compiler_Set.t) = - fun uu___ -> FStar_Compiler_Set.empty ord_bv () -let (new_id_set : unit -> FStar_Ident.ident FStar_Compiler_Set.t) = - fun uu___ -> FStar_Compiler_Set.empty ord_ident () -let (new_fv_set : unit -> FStar_Ident.lident FStar_Compiler_Set.t) = - fun uu___ -> FStar_Compiler_Set.empty ord_fv () -let (new_universe_names_set : unit -> univ_name FStar_Compiler_Set.t) = - fun uu___ -> FStar_Compiler_Set.empty ord_ident () -type path = Prims.string Prims.list -type subst_t = subst_elt Prims.list -let (no_names : freenames) = new_bv_set () -let (no_fvars : FStar_Ident.lident FStar_Compiler_Set.t) = new_fv_set () -let (no_universe_names : univ_name FStar_Compiler_Set.t) = - new_universe_names_set () -let (freenames_of_list : bv Prims.list -> freenames) = - fun l -> FStar_Compiler_Set.addn ord_bv l no_names let (list_of_freenames : freenames -> bv Prims.list) = - fun fvs -> FStar_Compiler_Set.elems ord_bv fvs + fun fvs -> + FStar_Class_Setlike.elems () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_bv)) + (Obj.magic fvs) let mk : 'a . 'a -> FStar_Compiler_Range_Type.range -> 'a syntax = fun t -> fun r -> @@ -2582,14 +2571,29 @@ let (is_top_level : letbinding Prims.list -> Prims.bool) = | uu___1 -> false let (freenames_of_binders : binders -> freenames) = fun bs -> + let uu___ = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_bv)) ()) in FStar_Compiler_List.fold_right - (fun b -> fun out -> FStar_Compiler_Set.add ord_bv b.binder_bv out) bs - no_names + (fun uu___2 -> + fun uu___1 -> + (fun b -> + fun out -> + Obj.magic + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set ord_bv)) + b.binder_bv (Obj.magic out))) uu___2 uu___1) bs uu___ let (binders_of_list : bv Prims.list -> binders) = fun fvs -> FStar_Compiler_List.map (fun t -> mk_binder t) fvs let (binders_of_freenames : freenames -> binders) = fun fvs -> - let uu___ = FStar_Compiler_Set.elems ord_bv fvs in binders_of_list uu___ + let uu___ = + FStar_Class_Setlike.elems () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_bv)) + (Obj.magic fvs) in + binders_of_list uu___ let (is_bqual_implicit : bqual -> Prims.bool) = fun uu___ -> match uu___ with diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml index c18150bba3e..7ddadaffc7d 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml @@ -211,13 +211,6 @@ let (binders_of_tks : (FStar_Pervasives_Native.Some (t.FStar_Syntax_Syntax.pos)) t in FStar_Syntax_Syntax.mk_binder_with_attrs uu___1 imp FStar_Pervasives_Native.None []) tks -let (binders_of_freevars : - FStar_Syntax_Syntax.bv FStar_Compiler_Set.set -> - FStar_Syntax_Syntax.binder Prims.list) - = - fun fvs -> - let uu___ = FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_bv fvs in - FStar_Compiler_List.map FStar_Syntax_Syntax.mk_binder uu___ let mk_subst : 'uuuuu . 'uuuuu -> 'uuuuu Prims.list = fun s -> [s] let (subst_of_list : FStar_Syntax_Syntax.binders -> @@ -2006,26 +1999,47 @@ let (let_rec_arity : let d_bvs = match d with | FStar_Syntax_Syntax.Decreases_lex l -> - let uu___2 = - FStar_Compiler_Set.empty FStar_Syntax_Syntax.ord_bv () in - FStar_Compiler_List.fold_left - (fun s -> - fun t -> - let uu___3 = FStar_Syntax_Free.names t in - FStar_Compiler_Set.union - FStar_Syntax_Syntax.ord_bv s uu___3) uu___2 l + Obj.magic + (Obj.repr + (let uu___2 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) ()) in + FStar_Compiler_List.fold_left + (fun uu___4 -> + fun uu___3 -> + (fun s -> + fun t -> + let uu___3 = FStar_Syntax_Free.names t in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic s) (Obj.magic uu___3))) + uu___4 uu___3) uu___2 l)) | FStar_Syntax_Syntax.Decreases_wf (rel, e) -> - let uu___2 = FStar_Syntax_Free.names rel in - let uu___3 = FStar_Syntax_Free.names e in - FStar_Compiler_Set.union FStar_Syntax_Syntax.ord_bv - uu___2 uu___3 in + Obj.magic + (Obj.repr + (let uu___2 = FStar_Syntax_Free.names rel in + let uu___3 = FStar_Syntax_Free.names e in + FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic uu___2) (Obj.magic uu___3))) in let uu___2 = FStar_Common.tabulate n_univs (fun uu___3 -> false) in let uu___3 = FStar_Compiler_List.map (fun b -> - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv - b.FStar_Syntax_Syntax.binder_bv d_bvs) bs in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + b.FStar_Syntax_Syntax.binder_bv (Obj.magic d_bvs)) bs in FStar_Compiler_List.op_At uu___2 uu___3) in ((n_univs + (FStar_Compiler_List.length bs)), uu___1) let (abs_formals_maybe_unascribe_body : @@ -3041,8 +3055,12 @@ let (un_squash : FStar_Compiler_Effect.failwith "impossible" in let uu___3 = let uu___4 = FStar_Syntax_Free.names p1 in - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv - b1.FStar_Syntax_Syntax.binder_bv uu___4 in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + b1.FStar_Syntax_Syntax.binder_bv + (Obj.magic uu___4) in if uu___3 then FStar_Pervasives_Native.None else FStar_Pervasives_Native.Some p1) @@ -3212,7 +3230,10 @@ let (is_free_in : fun bv -> fun t -> let uu___ = FStar_Syntax_Free.names t in - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv bv uu___ + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) bv (Obj.magic uu___) let (action_as_lb : FStar_Ident.lident -> FStar_Syntax_Syntax.action -> diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Monad.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Monad.ml index f31ba5a4957..85b7c484257 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Monad.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Monad.ml @@ -20,8 +20,10 @@ let (is_goal_safe_as_well_typed : FStar_Tactics_Types.goal -> Prims.bool) = match uu___1 with | FStar_Pervasives_Native.Some t -> let uu___2 = FStar_Syntax_Free.uvars t in - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_ctx_uvar - uu___2 + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___2) | uu___2 -> false) uu___ in all_deps_resolved let (register_goal : FStar_Tactics_Types.goal -> unit) = diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml index ff65da4b13b..b0786a86398 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml @@ -259,7 +259,10 @@ let (dump_uvars_of : let uu___ = let uu___1 = FStar_Tactics_Types.goal_type g in FStar_Syntax_Free.uvars uu___1 in - FStar_Compiler_Set.elems FStar_Syntax_Free.ord_ctx_uvar uu___ in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___) in let gs = FStar_Compiler_List.map (FStar_Tactics_Types.goal_of_ctx_uvar g) uvs in @@ -937,21 +940,39 @@ let (__do_unify_wflags : let uu___1 = match check_side with | Check_none -> - FStar_Syntax_Free.new_uv_set () + Obj.magic + (Obj.repr + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + ())) | Check_left_only -> - FStar_Syntax_Free.uvars t1 + Obj.magic + (Obj.repr + (FStar_Syntax_Free.uvars t1)) | Check_right_only -> - FStar_Syntax_Free.uvars t2 + Obj.magic + (Obj.repr + (FStar_Syntax_Free.uvars t2)) | Check_both -> - let uu___2 = - FStar_Syntax_Free.uvars t1 in - let uu___3 = - FStar_Syntax_Free.uvars t2 in - FStar_Compiler_Set.union - FStar_Syntax_Free.ord_ctx_uvar - uu___2 uu___3 in - FStar_Compiler_Set.elems - FStar_Syntax_Free.ord_ctx_uvar uu___1 in + Obj.magic + (Obj.repr + (let uu___2 = + FStar_Syntax_Free.uvars t1 in + let uu___3 = + FStar_Syntax_Free.uvars t2 in + FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___2) + (Obj.magic uu___3))) in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___1) in let uu___1 = let uu___2 = let uu___3 = @@ -1211,8 +1232,11 @@ let (do_match : let uvs2 = FStar_Syntax_Free.uvars_uncached t1 in let uu___4 = let uu___5 = - FStar_Compiler_Set.equal - FStar_Syntax_Free.ord_ctx_uvar uvs1 uvs2 in + FStar_Class_Setlike.equal () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uvs1) (Obj.magic uvs2) in Prims.op_Negation uu___5 in (if uu___4 then (FStar_Syntax_Unionfind.rollback tx; ret false) @@ -1252,8 +1276,11 @@ let (do_match_on_lhs : let uvs2 = FStar_Syntax_Free.uvars_uncached lhs in let uu___6 = let uu___7 = - FStar_Compiler_Set.equal - FStar_Syntax_Free.ord_ctx_uvar uvs1 uvs2 in + FStar_Class_Setlike.equal () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uvs1) (Obj.magic uvs2) in Prims.op_Negation uu___7 in (if uu___6 then @@ -3620,10 +3647,21 @@ let (t_apply : = let uu___11 = - FStar_Syntax_Free.new_uv_set - () in + Obj.magic + (FStar_Class_Setlike.empty + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + ()) in FStar_Compiler_List.fold_right (fun + uu___13 + -> + fun + uu___12 + -> + (fun uu___12 -> fun s -> @@ -3641,16 +3679,30 @@ let (t_apply : uv in FStar_Syntax_Free.uvars uu___16 in - FStar_Compiler_Set.union - FStar_Syntax_Free.ord_ctx_uvar - s uu___15) + Obj.magic + (FStar_Class_Setlike.union + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic + s) + (Obj.magic + uu___15))) + uu___13 + uu___12) uvs uu___11 in let free_in_some_goal uv = - FStar_Compiler_Set.mem - FStar_Syntax_Free.ord_ctx_uvar - uv uvset in + FStar_Class_Setlike.mem + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + uv + (Obj.magic + uvset) in let uu___11 = solve' @@ -4205,9 +4257,13 @@ let (t_apply_lemma : = FStar_Syntax_Free.uvars t1 in - FStar_Compiler_Set.elems - FStar_Syntax_Free.ord_ctx_uvar - uu___17 in + FStar_Class_Setlike.elems + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic + uu___17) in FStar_Compiler_List.map (fun x -> x.FStar_Syntax_Syntax.ctx_uvar_head) @@ -5041,7 +5097,10 @@ let (free_in : fun bv -> fun t -> let uu___ = FStar_Syntax_Free.names t in - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv bv uu___ + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) bv (Obj.magic uu___) let (clear : FStar_Syntax_Syntax.binder -> unit FStar_Tactics_Monad.tac) = fun b -> let bv = b.FStar_Syntax_Syntax.binder_bv in @@ -5265,7 +5324,10 @@ let (_t_trefl : g.FStar_Tactics_Types.goal_ctx_uvar in let uvars = let uu___2 = FStar_Syntax_Free.uvars t in - FStar_Compiler_Set.elems FStar_Syntax_Free.ord_ctx_uvar uu___2 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___2) in let uu___2 = FStar_Compiler_Util.for_all is_uvar_untyped_or_already_checked uvars in @@ -9288,8 +9350,11 @@ let (free_uvars : let uvs = let uu___1 = let uu___2 = FStar_Syntax_Free.uvars_uncached tm in - FStar_Compiler_Set.elems FStar_Syntax_Free.ord_ctx_uvar - uu___2 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___2) in FStar_Compiler_List.map (fun u -> let uu___2 = @@ -9343,9 +9408,16 @@ let refl_typing_builtin_wrapper : let (no_uvars_in_term : FStar_Syntax_Syntax.term -> Prims.bool) = fun t -> (let uu___ = FStar_Syntax_Free.uvars t in - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_ctx_uvar uu___) && + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___)) + && (let uu___ = FStar_Syntax_Free.univs t in - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_univ_uvar uu___) + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic uu___)) let (no_uvars_in_g : env -> Prims.bool) = fun g -> FStar_Compiler_Util.for_all diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml index c4de81c8b82..a40fec710a7 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml @@ -209,7 +209,10 @@ let (dump_uvars_of : let uu___ = let uu___1 = FStar_Tactics_Types.goal_type g in FStar_Syntax_Free.uvars uu___1 in - FStar_Compiler_Set.elems FStar_Syntax_Free.ord_ctx_uvar uu___ in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___) in let gs = FStar_Compiler_List.map (FStar_Tactics_Types.goal_of_ctx_uvar g) uvs in @@ -1001,21 +1004,39 @@ let (__do_unify_wflags : let uu___1 = match check_side with | Check_none -> - FStar_Syntax_Free.new_uv_set () + Obj.magic + (Obj.repr + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + ())) | Check_left_only -> - FStar_Syntax_Free.uvars t1 + Obj.magic + (Obj.repr + (FStar_Syntax_Free.uvars t1)) | Check_right_only -> - FStar_Syntax_Free.uvars t2 + Obj.magic + (Obj.repr + (FStar_Syntax_Free.uvars t2)) | Check_both -> - let uu___2 = - FStar_Syntax_Free.uvars t1 in - let uu___3 = - FStar_Syntax_Free.uvars t2 in - FStar_Compiler_Set.union - FStar_Syntax_Free.ord_ctx_uvar - uu___2 uu___3 in - FStar_Compiler_Set.elems - FStar_Syntax_Free.ord_ctx_uvar uu___1 in + Obj.magic + (Obj.repr + (let uu___2 = + FStar_Syntax_Free.uvars t1 in + let uu___3 = + FStar_Syntax_Free.uvars t2 in + FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___2) + (Obj.magic uu___3))) in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___1) in let uu___1 = let uu___2 = let uu___3 = @@ -1383,9 +1404,12 @@ let (do_match : t1 in let uu___2 = let uu___3 = - FStar_Compiler_Set.equal - FStar_Syntax_Free.ord_ctx_uvar - uvs1 uvs2 in + FStar_Class_Setlike.equal () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uvs1) + (Obj.magic uvs2) in Prims.op_Negation uu___3 in (if uu___2 then @@ -1460,9 +1484,13 @@ let (do_match_on_lhs : lhs in let uu___4 = let uu___5 = - FStar_Compiler_Set.equal - FStar_Syntax_Free.ord_ctx_uvar - uvs1 uvs2 in + FStar_Class_Setlike.equal + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uvs1) + (Obj.magic uvs2) in Prims.op_Negation uu___5 in (if uu___4 then @@ -4029,9 +4057,13 @@ let (t_apply : = FStar_Syntax_Free.uvars_uncached typ1 in - FStar_Compiler_Set.is_empty - FStar_Syntax_Free.ord_ctx_uvar - uu___11 in + FStar_Class_Setlike.is_empty + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic + uu___11) in Prims.op_Negation uu___10) in if uu___9 @@ -4147,10 +4179,21 @@ let (t_apply : = let uu___13 = - FStar_Syntax_Free.new_uv_set - () in + Obj.magic + (FStar_Class_Setlike.empty + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + ()) in FStar_Compiler_List.fold_right (fun + uu___15 + -> + fun + uu___14 + -> + (fun uu___14 -> fun s -> @@ -4168,16 +4211,30 @@ let (t_apply : uv in FStar_Syntax_Free.uvars uu___18 in - FStar_Compiler_Set.union - FStar_Syntax_Free.ord_ctx_uvar - s uu___17) + Obj.magic + (FStar_Class_Setlike.union + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic + s) + (Obj.magic + uu___17))) + uu___15 + uu___14) uvs uu___13 in let free_in_some_goal uv = - FStar_Compiler_Set.mem - FStar_Syntax_Free.ord_ctx_uvar - uv uvset in + FStar_Class_Setlike.mem + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + uv + (Obj.magic + uvset) in let uu___13 = solve' @@ -4770,13 +4827,17 @@ let (t_apply_lemma : = FStar_Syntax_Free.uvars t1 in - FStar_Compiler_Set.for_any - FStar_Syntax_Free.ord_ctx_uvar + FStar_Class_Setlike.for_any + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (fun u -> FStar_Syntax_Unionfind.equiv u.FStar_Syntax_Syntax.ctx_uvar_head uv) - uu___16 in + (Obj.magic + uu___16) in let appears uv goals = @@ -5618,7 +5679,10 @@ let (free_in : fun bv -> fun t -> let uu___ = FStar_Syntax_Free.names t in - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv bv uu___ + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) bv (Obj.magic uu___) let (clear : FStar_Reflection_V2_Data.binding -> unit FStar_Tactics_Monad.tac) = fun b -> @@ -5845,8 +5909,11 @@ let (_t_trefl : g.FStar_Tactics_Types.goal_ctx_uvar in let uvars = FStar_Syntax_Free.uvars t in let uu___2 = - FStar_Compiler_Set.for_all FStar_Syntax_Free.ord_ctx_uvar - is_uvar_untyped_or_already_checked uvars in + FStar_Class_Setlike.for_all () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + is_uvar_untyped_or_already_checked (Obj.magic uvars) in if uu___2 then skip_register else @@ -9610,8 +9677,11 @@ let (free_uvars : let uvs = let uu___2 = let uu___3 = FStar_Syntax_Free.uvars_uncached tm in - FStar_Compiler_Set.elems FStar_Syntax_Free.ord_ctx_uvar - uu___3 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___3) in FStar_Compiler_List.map (fun u -> let uu___3 = @@ -9909,13 +9979,23 @@ let refl_typing_builtin_wrapper : let (no_uvars_in_term : FStar_Syntax_Syntax.term -> Prims.bool) = fun t -> (let uu___ = FStar_Syntax_Free.uvars t in - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_ctx_uvar uu___) && + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___)) + && (let uu___ = FStar_Syntax_Free.univs t in - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_univ_uvar uu___) + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic uu___)) let (no_univ_uvars_in_term : FStar_Syntax_Syntax.term -> Prims.bool) = fun t -> let uu___ = FStar_Syntax_Free.univs t in - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_univ_uvar uu___ + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic uu___) let (no_uvars_in_g : env -> Prims.bool) = fun g -> FStar_Compiler_Util.for_all @@ -11804,9 +11884,13 @@ let (refl_try_unify : = FStar_Syntax_Free.uvars_full t2 in - FStar_Compiler_Set.is_empty - FStar_Syntax_Free.ord_ctx_uvar - uu___9 in + FStar_Class_Setlike.is_empty + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic + uu___9) in if uu___8 then (bv, t2) diff --git a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml index ee9b4b36c5e..710914b9822 100644 --- a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml +++ b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml @@ -892,40 +892,70 @@ let rec (destruct_app_pattern : ((FStar_Pervasives.Inl id), args, FStar_Pervasives_Native.None) | uu___ -> FStar_Compiler_Effect.failwith "Not an app pattern" let rec (gather_pattern_bound_vars_maybe_top : - FStar_Ident.ident FStar_Compiler_Set.set -> - FStar_Parser_AST.pattern -> FStar_Ident.ident FStar_Compiler_Set.set) + FStar_Ident.ident FStar_Compiler_FlatSet.t -> + FStar_Parser_AST.pattern -> FStar_Ident.ident FStar_Compiler_FlatSet.t) = - fun acc -> - fun p -> - let gather_pattern_bound_vars_from_list = - FStar_Compiler_List.fold_left gather_pattern_bound_vars_maybe_top acc in - match p.FStar_Parser_AST.pat with - | FStar_Parser_AST.PatWild uu___ -> acc - | FStar_Parser_AST.PatConst uu___ -> acc - | FStar_Parser_AST.PatVQuote uu___ -> acc - | FStar_Parser_AST.PatName uu___ -> acc - | FStar_Parser_AST.PatOp uu___ -> acc - | FStar_Parser_AST.PatApp (phead, pats) -> - gather_pattern_bound_vars_from_list (phead :: pats) - | FStar_Parser_AST.PatTvar (x, uu___, uu___1) -> - FStar_Compiler_Set.add FStar_Syntax_Syntax.ord_ident x acc - | FStar_Parser_AST.PatVar (x, uu___, uu___1) -> - FStar_Compiler_Set.add FStar_Syntax_Syntax.ord_ident x acc - | FStar_Parser_AST.PatList pats -> - gather_pattern_bound_vars_from_list pats - | FStar_Parser_AST.PatTuple (pats, uu___) -> - gather_pattern_bound_vars_from_list pats - | FStar_Parser_AST.PatOr pats -> - gather_pattern_bound_vars_from_list pats - | FStar_Parser_AST.PatRecord guarded_pats -> - let uu___ = - FStar_Compiler_List.map FStar_Pervasives_Native.snd guarded_pats in - gather_pattern_bound_vars_from_list uu___ - | FStar_Parser_AST.PatAscribed (pat, uu___) -> - gather_pattern_bound_vars_maybe_top acc pat + fun uu___1 -> + fun uu___ -> + (fun acc -> + fun p -> + let gather_pattern_bound_vars_from_list = + FStar_Compiler_List.fold_left + gather_pattern_bound_vars_maybe_top acc in + match p.FStar_Parser_AST.pat with + | FStar_Parser_AST.PatWild uu___ -> Obj.magic (Obj.repr acc) + | FStar_Parser_AST.PatConst uu___ -> Obj.magic (Obj.repr acc) + | FStar_Parser_AST.PatVQuote uu___ -> Obj.magic (Obj.repr acc) + | FStar_Parser_AST.PatName uu___ -> Obj.magic (Obj.repr acc) + | FStar_Parser_AST.PatOp uu___ -> Obj.magic (Obj.repr acc) + | FStar_Parser_AST.PatApp (phead, pats) -> + Obj.magic + (Obj.repr + (gather_pattern_bound_vars_from_list (phead :: pats))) + | FStar_Parser_AST.PatTvar (x, uu___, uu___1) -> + Obj.magic + (Obj.repr + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) x + (Obj.magic acc))) + | FStar_Parser_AST.PatVar (x, uu___, uu___1) -> + Obj.magic + (Obj.repr + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) x + (Obj.magic acc))) + | FStar_Parser_AST.PatList pats -> + Obj.magic + (Obj.repr (gather_pattern_bound_vars_from_list pats)) + | FStar_Parser_AST.PatTuple (pats, uu___) -> + Obj.magic + (Obj.repr (gather_pattern_bound_vars_from_list pats)) + | FStar_Parser_AST.PatOr pats -> + Obj.magic + (Obj.repr (gather_pattern_bound_vars_from_list pats)) + | FStar_Parser_AST.PatRecord guarded_pats -> + Obj.magic + (Obj.repr + (let uu___ = + FStar_Compiler_List.map FStar_Pervasives_Native.snd + guarded_pats in + gather_pattern_bound_vars_from_list uu___)) + | FStar_Parser_AST.PatAscribed (pat, uu___) -> + Obj.magic + (Obj.repr (gather_pattern_bound_vars_maybe_top acc pat))) + uu___1 uu___ let (gather_pattern_bound_vars : - FStar_Parser_AST.pattern -> FStar_Ident.ident FStar_Compiler_Set.set) = - let acc = FStar_Compiler_Set.empty FStar_Syntax_Syntax.ord_ident () in + FStar_Parser_AST.pattern -> FStar_Ident.ident FStar_Compiler_FlatSet.t) = + let acc = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) ()) in fun p -> gather_pattern_bound_vars_maybe_top acc p type bnd = | LocalBinder of (FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.bqual * @@ -1073,19 +1103,31 @@ let rec (generalize_annotated_univs : fun s -> let vars = FStar_Compiler_Util.mk_ref [] in let seen = - let uu___ = FStar_Compiler_Set.empty FStar_Syntax_Syntax.ord_ident () in + let uu___ = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_ident)) ()) in FStar_Compiler_Util.mk_ref uu___ in let reg u = let uu___ = let uu___1 = let uu___2 = FStar_Compiler_Effect.op_Bang seen in - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_ident u uu___2 in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_ident)) u (Obj.magic uu___2) in Prims.op_Negation uu___1 in if uu___ then ((let uu___2 = let uu___3 = FStar_Compiler_Effect.op_Bang seen in - FStar_Compiler_Set.add FStar_Syntax_Syntax.ord_ident u uu___3 in + Obj.magic + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_ident)) u (Obj.magic uu___3)) in FStar_Compiler_Effect.op_Colon_Equals seen uu___2); (let uu___2 = let uu___3 = FStar_Compiler_Effect.op_Bang vars in u :: uu___3 in @@ -1370,7 +1412,10 @@ let rec (generalize_annotated_univs : | FStar_Syntax_Syntax.Layered_eff_sig (n, (uu___1, t)) -> let uvs = let uu___2 = FStar_Syntax_Free.univnames t in - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_ident uu___2 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) (Obj.magic uu___2) in let usubst = FStar_Syntax_Subst.univ_var_closing uvs in let uu___2 = let uu___3 = @@ -1381,7 +1426,10 @@ let rec (generalize_annotated_univs : | FStar_Syntax_Syntax.WP_eff_sig (uu___1, t) -> let uvs = let uu___2 = FStar_Syntax_Free.univnames t in - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_ident uu___2 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) (Obj.magic uu___2) in let usubst = FStar_Syntax_Subst.univ_var_closing uvs in let uu___2 = let uu___3 = FStar_Syntax_Subst.subst usubst t in @@ -1603,56 +1651,103 @@ let (check_linear_pattern_variables : = fun pats -> fun r -> - let rec pat_vars p = - match p.FStar_Syntax_Syntax.v with - | FStar_Syntax_Syntax.Pat_dot_term uu___ -> - FStar_Syntax_Syntax.no_names - | FStar_Syntax_Syntax.Pat_constant uu___ -> - FStar_Syntax_Syntax.no_names - | FStar_Syntax_Syntax.Pat_var x -> - let uu___ = - let uu___1 = - FStar_Ident.string_of_id x.FStar_Syntax_Syntax.ppname in - uu___1 = FStar_Ident.reserved_prefix in - if uu___ - then FStar_Syntax_Syntax.no_names - else - FStar_Compiler_Set.add FStar_Syntax_Syntax.ord_bv x - FStar_Syntax_Syntax.no_names - | FStar_Syntax_Syntax.Pat_cons (uu___, uu___1, pats1) -> - let aux out uu___2 = - match uu___2 with - | (p1, uu___3) -> - let p_vars = pat_vars p1 in - let intersection = - FStar_Compiler_Set.inter FStar_Syntax_Syntax.ord_bv - p_vars out in - let uu___4 = - FStar_Compiler_Set.is_empty FStar_Syntax_Syntax.ord_bv - intersection in - if uu___4 - then - FStar_Compiler_Set.union FStar_Syntax_Syntax.ord_bv out - p_vars - else - (let duplicate_bv = - let uu___6 = - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_bv - intersection in - FStar_Compiler_List.hd uu___6 in - let uu___6 = - let uu___7 = - let uu___8 = - FStar_Ident.string_of_id - duplicate_bv.FStar_Syntax_Syntax.ppname in - FStar_Compiler_Util.format1 - "Non-linear patterns are not permitted: `%s` appears more than once in this pattern." - uu___8 in - (FStar_Errors_Codes.Fatal_NonLinearPatternNotPermitted, - uu___7) in - FStar_Errors.raise_error uu___6 r) in - FStar_Compiler_List.fold_left aux FStar_Syntax_Syntax.no_names - pats1 in + let rec pat_vars uu___ = + (fun p -> + match p.FStar_Syntax_Syntax.v with + | FStar_Syntax_Syntax.Pat_dot_term uu___ -> + Obj.magic + (Obj.repr + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) ())) + | FStar_Syntax_Syntax.Pat_constant uu___ -> + Obj.magic + (Obj.repr + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) ())) + | FStar_Syntax_Syntax.Pat_var x -> + Obj.magic + (Obj.repr + (let uu___ = + let uu___1 = + FStar_Ident.string_of_id + x.FStar_Syntax_Syntax.ppname in + uu___1 = FStar_Ident.reserved_prefix in + if uu___ + then + FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) () + else + FStar_Class_Setlike.singleton () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) x)) + | FStar_Syntax_Syntax.Pat_cons (uu___, uu___1, pats1) -> + Obj.magic + (Obj.repr + (let aux uu___3 uu___2 = + (fun out -> + fun uu___2 -> + match uu___2 with + | (p1, uu___3) -> + let p_vars = pat_vars p1 in + let intersection = + Obj.magic + (FStar_Class_Setlike.inter () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic p_vars) (Obj.magic out)) in + let uu___4 = + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic intersection) in + if uu___4 + then + Obj.magic + (Obj.repr + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic out) (Obj.magic p_vars))) + else + Obj.magic + (Obj.repr + (let duplicate_bv = + let uu___6 = + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic intersection) in + FStar_Compiler_List.hd uu___6 in + let uu___6 = + let uu___7 = + let uu___8 = + FStar_Ident.string_of_id + duplicate_bv.FStar_Syntax_Syntax.ppname in + FStar_Compiler_Util.format1 + "Non-linear patterns are not permitted: `%s` appears more than once in this pattern." + uu___8 in + (FStar_Errors_Codes.Fatal_NonLinearPatternNotPermitted, + uu___7) in + FStar_Errors.raise_error uu___6 r))) + uu___3 uu___2 in + let uu___2 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) ()) in + FStar_Compiler_List.fold_left aux uu___2 pats1))) uu___ in match pats with | [] -> () | p::[] -> let uu___ = pat_vars p in () @@ -1661,24 +1756,47 @@ let (check_linear_pattern_variables : let aux p1 = let uu___ = let uu___1 = pat_vars p1 in - FStar_Compiler_Set.equal FStar_Syntax_Syntax.ord_bv pvars - uu___1 in + FStar_Class_Setlike.equal () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) (Obj.magic pvars) + (Obj.magic uu___1) in if uu___ then () else - (let symdiff s1 s2 = - let uu___2 = - FStar_Compiler_Set.diff FStar_Syntax_Syntax.ord_bv s1 s2 in - let uu___3 = - FStar_Compiler_Set.diff FStar_Syntax_Syntax.ord_bv s2 s1 in - FStar_Compiler_Set.union FStar_Syntax_Syntax.ord_bv uu___2 - uu___3 in + (let symdiff uu___3 uu___2 = + (fun s1 -> + fun s2 -> + let uu___2 = + Obj.magic + (FStar_Class_Setlike.diff () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic s1) (Obj.magic s2)) in + let uu___3 = + Obj.magic + (FStar_Class_Setlike.diff () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic s2) (Obj.magic s1)) in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic uu___2) (Obj.magic uu___3))) uu___3 + uu___2 in let nonlinear_vars = let uu___2 = pat_vars p1 in symdiff pvars uu___2 in let first_nonlinear_var = let uu___2 = - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_bv - nonlinear_vars in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic nonlinear_vars) in FStar_Compiler_List.hd uu___2 in let uu___2 = let uu___3 = @@ -3072,25 +3190,43 @@ and (desugar_term_maybe_top : | [] -> FStar_Pervasives_Native.None | set::sets2 -> let i = - FStar_Compiler_Set.inter FStar_Syntax_Syntax.ord_ident - acc set in + Obj.magic + (FStar_Class_Setlike.inter () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) + (Obj.magic acc) (Obj.magic set)) in let uu___1 = - FStar_Compiler_Set.is_empty - FStar_Syntax_Syntax.ord_ident i in + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) (Obj.magic i) in if uu___1 then let uu___2 = - FStar_Compiler_Set.union - FStar_Syntax_Syntax.ord_ident acc set in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) + (Obj.magic acc) (Obj.magic set)) in aux uu___2 sets2 else (let uu___3 = let uu___4 = - FStar_Compiler_Set.elems - FStar_Syntax_Syntax.ord_ident i in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) + (Obj.magic i) in FStar_Compiler_List.hd uu___4 in FStar_Pervasives_Native.Some uu___3) in - let uu___1 = FStar_Syntax_Syntax.new_id_set () in + let uu___1 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) ()) in aux uu___1 sets in ((let uu___2 = check_disjoint bvss in match uu___2 with @@ -3098,14 +3234,28 @@ and (desugar_term_maybe_top : | FStar_Pervasives_Native.Some id -> let uu___3 = let uu___4 = - let uu___5 = FStar_Ident.string_of_id id in - FStar_Compiler_Util.format1 - "Non-linear patterns are not permitted: `%s` appears more than once in this function definition." - uu___5 in + let uu___5 = + FStar_Errors_Msg.text + "Non-linear patterns are not permitted." in + let uu___6 = + let uu___7 = + let uu___8 = FStar_Errors_Msg.text "The variable " in + let uu___9 = + let uu___10 = + let uu___11 = + FStar_Class_PP.pp FStar_Ident.pretty_ident id in + FStar_Pprint.squotes uu___11 in + let uu___11 = + FStar_Errors_Msg.text + " appears more than once in this function definition." in + FStar_Pprint.op_Hat_Slash_Hat uu___10 uu___11 in + FStar_Pprint.op_Hat_Slash_Hat uu___8 uu___9 in + [uu___7] in + uu___5 :: uu___6 in (FStar_Errors_Codes.Fatal_NonLinearPatternNotPermitted, uu___4) in let uu___4 = FStar_Ident.range_of_id id in - FStar_Errors.raise_error uu___3 uu___4); + FStar_Errors.raise_error_doc uu___3 uu___4); (let binders1 = FStar_Compiler_List.map replace_unit_pattern binders in let uu___2 = @@ -4415,8 +4565,10 @@ and (desugar_term_maybe_top : ((let fvs = FStar_Syntax_Free.names tm1 in let uu___3 = let uu___4 = - FStar_Compiler_Set.is_empty FStar_Syntax_Syntax.ord_bv - fvs in + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) (Obj.magic fvs) in Prims.op_Negation uu___4 in if uu___3 then @@ -4424,7 +4576,7 @@ and (desugar_term_maybe_top : let uu___5 = let uu___6 = FStar_Class_Show.show - (FStar_Compiler_Set.showable_set + (FStar_Compiler_FlatSet.showable_set FStar_Syntax_Syntax.ord_bv FStar_Syntax_Print.showable_bv) fvs in FStar_Compiler_Util.format1 @@ -9608,8 +9760,11 @@ and (desugar_decl_core : FStar_Pervasives_Native.None in let bvs = let uu___2 = gather_pattern_bound_vars pat in - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_ident - uu___2 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) + (Obj.magic uu___2) in let uu___2 = (FStar_Compiler_List.isEmpty bvs) && (let uu___3 = is_var_pattern pat in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml index b13f18135fb..a33bc00b5aa 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml @@ -1338,8 +1338,11 @@ let (check_no_escape : FStar_Compiler_Util.for_all (fun b -> let uu___1 = - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv - b.FStar_Syntax_Syntax.binder_bv xs in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + b.FStar_Syntax_Syntax.binder_bv (Obj.magic xs) in Prims.op_Negation uu___1) bs in if uu___ then fun uu___1 -> Success ((), FStar_Pervasives_Native.None) @@ -7851,8 +7854,11 @@ let (check_term_top_gh : uu___7 uu___8 uu___9); (let guard_names = let uu___7 = FStar_Syntax_Free.names guard1 in - FStar_Compiler_Set.elems - FStar_Syntax_Syntax.ord_bv uu___7 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic uu___7) in let uu___7 = FStar_Compiler_List.tryFind (fun bv -> diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml index b2bd4a6406a..26392457f1f 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml @@ -1616,7 +1616,10 @@ and (star_type' : let debug t2 s = let string_of_set f s1 = let elts = - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_bv s1 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) (Obj.magic s1) in match elts with | [] -> "{}" | x::xs -> @@ -1662,12 +1665,19 @@ and (star_type' : let non_dependent_or_raise s ty1 = let sinter = let uu___4 = FStar_Syntax_Free.names ty1 in - FStar_Compiler_Set.inter - FStar_Syntax_Syntax.ord_bv uu___4 s in + Obj.magic + (FStar_Class_Setlike.inter () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic uu___4) (Obj.magic s)) in let uu___4 = let uu___5 = - FStar_Compiler_Set.is_empty - FStar_Syntax_Syntax.ord_bv sinter in + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic sinter) in Prims.op_Negation uu___5 in if uu___4 then @@ -1679,26 +1689,39 @@ and (star_type' : (match uu___4 with | (binders1, c1) -> let s = + let uu___5 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + ()) in FStar_Compiler_List.fold_left - (fun s1 -> - fun uu___5 -> - match uu___5 with - | { - FStar_Syntax_Syntax.binder_bv = - bv; - FStar_Syntax_Syntax.binder_qual - = uu___6; - FStar_Syntax_Syntax.binder_positivity - = uu___7; - FStar_Syntax_Syntax.binder_attrs - = uu___8;_} - -> - (non_dependent_or_raise s1 - bv.FStar_Syntax_Syntax.sort; - FStar_Compiler_Set.add - FStar_Syntax_Syntax.ord_bv - bv s1)) - FStar_Syntax_Syntax.no_names binders1 in + (fun uu___7 -> + fun uu___6 -> + (fun s1 -> + fun uu___6 -> + match uu___6 with + | { + FStar_Syntax_Syntax.binder_bv + = bv; + FStar_Syntax_Syntax.binder_qual + = uu___7; + FStar_Syntax_Syntax.binder_positivity + = uu___8; + FStar_Syntax_Syntax.binder_attrs + = uu___9;_} + -> + (non_dependent_or_raise s1 + bv.FStar_Syntax_Syntax.sort; + Obj.magic + (FStar_Class_Setlike.add + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + bv (Obj.magic s1)))) + uu___7 uu___6) uu___5 binders1 in let ct = FStar_Syntax_Util.comp_result c1 in (non_dependent_or_raise s ct; (let k = @@ -4896,10 +4919,14 @@ let (cps_and_elaborate : = FStar_Syntax_Free.names bv.FStar_Syntax_Syntax.sort in - FStar_Compiler_Set.mem - FStar_Syntax_Syntax.ord_bv + FStar_Class_Setlike.mem + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) type_param1.FStar_Syntax_Syntax.binder_bv - uu___28 in + (Obj.magic + uu___28) in Prims.op_Negation uu___27) wp_binders1 in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml index 9492a87af31..7b0d9d3fa16 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml @@ -53,87 +53,6 @@ let (uu___is_Imp : goal_type -> Prims.bool) = fun projectee -> match projectee with | Imp _0 -> true | uu___ -> false let (__proj__Imp__item___0 : goal_type -> FStar_Syntax_Syntax.ctx_uvar) = fun projectee -> match projectee with | Imp _0 -> _0 -type goal_dep = - { - goal_dep_id: Prims.int ; - goal_type: goal_type ; - goal_imp: FStar_TypeChecker_Common.implicit ; - assignees: FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.t ; - goal_dep_uvars: FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.t ; - dependences: goal_dep Prims.list FStar_Compiler_Effect.ref ; - visited: Prims.int FStar_Compiler_Effect.ref } -let (__proj__Mkgoal_dep__item__goal_dep_id : goal_dep -> Prims.int) = - fun projectee -> - match projectee with - | { goal_dep_id; goal_type = goal_type1; goal_imp; assignees; - goal_dep_uvars; dependences; visited;_} -> goal_dep_id -let (__proj__Mkgoal_dep__item__goal_type : goal_dep -> goal_type) = - fun projectee -> - match projectee with - | { goal_dep_id; goal_type = goal_type1; goal_imp; assignees; - goal_dep_uvars; dependences; visited;_} -> goal_type1 -let (__proj__Mkgoal_dep__item__goal_imp : - goal_dep -> FStar_TypeChecker_Common.implicit) = - fun projectee -> - match projectee with - | { goal_dep_id; goal_type = goal_type1; goal_imp; assignees; - goal_dep_uvars; dependences; visited;_} -> goal_imp -let (__proj__Mkgoal_dep__item__assignees : - goal_dep -> FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.t) = - fun projectee -> - match projectee with - | { goal_dep_id; goal_type = goal_type1; goal_imp; assignees; - goal_dep_uvars; dependences; visited;_} -> assignees -let (__proj__Mkgoal_dep__item__goal_dep_uvars : - goal_dep -> FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.t) = - fun projectee -> - match projectee with - | { goal_dep_id; goal_type = goal_type1; goal_imp; assignees; - goal_dep_uvars; dependences; visited;_} -> goal_dep_uvars -let (__proj__Mkgoal_dep__item__dependences : - goal_dep -> goal_dep Prims.list FStar_Compiler_Effect.ref) = - fun projectee -> - match projectee with - | { goal_dep_id; goal_type = goal_type1; goal_imp; assignees; - goal_dep_uvars; dependences; visited;_} -> dependences -let (__proj__Mkgoal_dep__item__visited : - goal_dep -> Prims.int FStar_Compiler_Effect.ref) = - fun projectee -> - match projectee with - | { goal_dep_id; goal_type = goal_type1; goal_imp; assignees; - goal_dep_uvars; dependences; visited;_} -> visited -type goal_deps = goal_dep Prims.list -let (print_uvar_set : - FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.t -> Prims.string) = - fun s -> - let uu___ = - let uu___1 = FStar_Compiler_Set.elems FStar_Syntax_Free.ord_ctx_uvar s in - FStar_Compiler_List.map - (fun u -> - let uu___2 = - let uu___3 = - FStar_Syntax_Unionfind.uvar_id - u.FStar_Syntax_Syntax.ctx_uvar_head in - FStar_Compiler_Util.string_of_int uu___3 in - Prims.strcat "?" uu___2) uu___1 in - FStar_Compiler_String.concat "; " uu___ -let (print_goal_dep : goal_dep -> Prims.string) = - fun gd -> - let uu___ = FStar_Compiler_Util.string_of_int gd.goal_dep_id in - let uu___1 = print_uvar_set gd.assignees in - let uu___2 = - let uu___3 = - let uu___4 = FStar_Compiler_Effect.op_Bang gd.dependences in - FStar_Compiler_List.map - (fun gd1 -> FStar_Compiler_Util.string_of_int gd1.goal_dep_id) - uu___4 in - FStar_Compiler_String.concat "; " uu___3 in - let uu___3 = - FStar_Syntax_Print.ctx_uvar_to_string - (gd.goal_imp).FStar_TypeChecker_Common.imp_uvar in - FStar_Compiler_Util.format4 - "%s:{assignees=[%s], dependences=[%s]}\n\t%s\n" uu___ uu___1 uu___2 - uu___3 let (find_user_tac_for_uvar : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.ctx_uvar -> diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml index 40dcddbfd53..0f575764d77 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml @@ -4715,9 +4715,14 @@ let (bound_vars : env -> FStar_Syntax_Syntax.bv Prims.list) = let (hasBinders_env : env FStar_Class_Binders.hasBinders) = { FStar_Class_Binders.boundNames = - (fun e -> - let uu___ = bound_vars e in - FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_bv uu___) + (fun uu___ -> + (fun e -> + let uu___ = bound_vars e in + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) uu___)) uu___) } let (hasNames_lcomp : FStar_TypeChecker_Common.lcomp FStar_Class_Binders.hasNames) = @@ -4735,13 +4740,21 @@ let (pretty_lcomp : FStar_TypeChecker_Common.lcomp FStar_Class_PP.pretty) = let (hasNames_guard : guard_t FStar_Class_Binders.hasNames) = { FStar_Class_Binders.freeNames = - (fun g -> - match g.FStar_TypeChecker_Common.guard_f with - | FStar_TypeChecker_Common.Trivial -> - FStar_Compiler_Set.empty FStar_Syntax_Syntax.ord_bv () - | FStar_TypeChecker_Common.NonTrivial f -> - FStar_Class_Binders.freeNames FStar_Class_Binders.hasNames_term - f) + (fun uu___ -> + (fun g -> + match g.FStar_TypeChecker_Common.guard_f with + | FStar_TypeChecker_Common.Trivial -> + Obj.magic + (Obj.repr + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) ())) + | FStar_TypeChecker_Common.NonTrivial f -> + Obj.magic + (Obj.repr + (FStar_Class_Binders.freeNames + FStar_Class_Binders.hasNames_term f))) uu___) } let (pretty_guard : guard_t FStar_Class_PP.pretty) = { @@ -6207,16 +6220,25 @@ let (finish_module : env -> FStar_Syntax_Syntax.modul -> env) = } let (uvars_in_env : env -> FStar_Syntax_Syntax.uvars) = fun env1 -> - let no_uvs = FStar_Syntax_Free.new_uv_set () in - let ext out uvs = - FStar_Compiler_Set.union FStar_Syntax_Free.ord_ctx_uvar out uvs in + let no_uvs = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) ()) in let rec aux out g = match g with | [] -> out | (FStar_Syntax_Syntax.Binding_univ uu___)::tl -> aux out tl | (FStar_Syntax_Syntax.Binding_lid (uu___, (uu___1, t)))::tl -> let uu___2 = - let uu___3 = FStar_Syntax_Free.uvars t in ext out uu___3 in + let uu___3 = FStar_Syntax_Free.uvars t in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic out) + (Obj.magic uu___3)) in aux uu___2 tl | (FStar_Syntax_Syntax.Binding_var { FStar_Syntax_Syntax.ppname = uu___; @@ -6224,22 +6246,37 @@ let (uvars_in_env : env -> FStar_Syntax_Syntax.uvars) = FStar_Syntax_Syntax.sort = t;_})::tl -> let uu___2 = - let uu___3 = FStar_Syntax_Free.uvars t in ext out uu___3 in + let uu___3 = FStar_Syntax_Free.uvars t in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic out) + (Obj.magic uu___3)) in aux uu___2 tl in aux no_uvs env1.gamma let (univ_vars : - env -> FStar_Syntax_Syntax.universe_uvar FStar_Compiler_Set.set) = + env -> FStar_Syntax_Syntax.universe_uvar FStar_Compiler_FlatSet.t) = fun env1 -> - let no_univs = FStar_Syntax_Free.new_universe_uvar_set () in - let ext out uvs = - FStar_Compiler_Set.union FStar_Syntax_Free.ord_univ_uvar out uvs in + let no_univs = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) ()) in let rec aux out g = match g with | [] -> out | (FStar_Syntax_Syntax.Binding_univ uu___)::tl -> aux out tl | (FStar_Syntax_Syntax.Binding_lid (uu___, (uu___1, t)))::tl -> let uu___2 = - let uu___3 = FStar_Syntax_Free.univs t in ext out uu___3 in + let uu___3 = FStar_Syntax_Free.univs t in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic out) + (Obj.magic uu___3)) in aux uu___2 tl | (FStar_Syntax_Syntax.Binding_var { FStar_Syntax_Syntax.ppname = uu___; @@ -6247,25 +6284,44 @@ let (univ_vars : FStar_Syntax_Syntax.sort = t;_})::tl -> let uu___2 = - let uu___3 = FStar_Syntax_Free.univs t in ext out uu___3 in + let uu___3 = FStar_Syntax_Free.univs t in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic out) + (Obj.magic uu___3)) in aux uu___2 tl in aux no_univs env1.gamma -let (univnames : env -> FStar_Syntax_Syntax.univ_name FStar_Compiler_Set.set) - = +let (univnames : + env -> FStar_Syntax_Syntax.univ_name FStar_Compiler_FlatSet.t) = fun env1 -> - let no_univ_names = FStar_Syntax_Syntax.no_universe_names in - let ext out uvs = - FStar_Compiler_Set.union FStar_Syntax_Syntax.ord_ident out uvs in + let no_univ_names = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) ()) in let rec aux out g = match g with | [] -> out | (FStar_Syntax_Syntax.Binding_univ uname)::tl -> let uu___ = - FStar_Compiler_Set.add FStar_Syntax_Syntax.ord_ident uname out in + Obj.magic + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) uname (Obj.magic out)) in aux uu___ tl | (FStar_Syntax_Syntax.Binding_lid (uu___, (uu___1, t)))::tl -> let uu___2 = - let uu___3 = FStar_Syntax_Free.univnames t in ext out uu___3 in + let uu___3 = FStar_Syntax_Free.univnames t in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) (Obj.magic out) + (Obj.magic uu___3)) in aux uu___2 tl | (FStar_Syntax_Syntax.Binding_var { FStar_Syntax_Syntax.ppname = uu___; @@ -6273,7 +6329,13 @@ let (univnames : env -> FStar_Syntax_Syntax.univ_name FStar_Compiler_Set.set) FStar_Syntax_Syntax.sort = t;_})::tl -> let uu___2 = - let uu___3 = FStar_Syntax_Free.univnames t in ext out uu___3 in + let uu___3 = FStar_Syntax_Free.univnames t in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) (Obj.magic out) + (Obj.magic uu___3)) in aux uu___2 tl in aux no_univ_names env1.gamma let (lidents : env -> FStar_Ident.lident Prims.list) = @@ -6433,26 +6495,39 @@ let (set_proof_ns : proof_namespace -> env -> env) = } let (unbound_vars : env -> - FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.set) + FStar_Syntax_Syntax.term -> + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t) = fun e -> fun t -> let uu___ = FStar_Syntax_Free.names t in let uu___1 = bound_vars e in FStar_Compiler_List.fold_left - (fun s -> - fun bv -> - FStar_Compiler_Set.remove FStar_Syntax_Syntax.ord_bv bv s) uu___ - uu___1 + (fun uu___3 -> + fun uu___2 -> + (fun s -> + fun bv -> + Obj.magic + (FStar_Class_Setlike.remove () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) bv (Obj.magic s))) + uu___3 uu___2) uu___ uu___1 let (closed : env -> FStar_Syntax_Syntax.term -> Prims.bool) = fun e -> fun t -> let uu___ = unbound_vars e t in - FStar_Compiler_Set.is_empty FStar_Syntax_Syntax.ord_bv uu___ + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) (Obj.magic uu___) let (closed' : FStar_Syntax_Syntax.term -> Prims.bool) = fun t -> let uu___ = FStar_Syntax_Free.names t in - FStar_Compiler_Set.is_empty FStar_Syntax_Syntax.ord_bv uu___ + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set FStar_Syntax_Syntax.ord_bv)) + (Obj.magic uu___) let (string_of_proof_ns : env -> Prims.string) = fun env1 -> let aux uu___ = diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Generalize.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Generalize.ml index fdf1d88d65a..7010485cd85 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Generalize.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Generalize.ml @@ -9,21 +9,32 @@ let (showable_univ_var : } let (gen_univs : FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.universe_uvar FStar_Compiler_Set.t -> + FStar_Syntax_Syntax.universe_uvar FStar_Compiler_FlatSet.t -> FStar_Syntax_Syntax.univ_name Prims.list) = fun env -> fun x -> let uu___ = - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_univ_uvar x in + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic x) in if uu___ then [] else (let s = let uu___2 = let uu___3 = FStar_TypeChecker_Env.univ_vars env in - FStar_Compiler_Set.diff FStar_Syntax_Free.ord_univ_uvar x uu___3 in - FStar_Compiler_Set.elems FStar_Syntax_Free.ord_univ_uvar uu___2 in + Obj.magic + (FStar_Class_Setlike.diff () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic x) + (Obj.magic uu___3)) in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic uu___2) in (let uu___3 = FStar_TypeChecker_Env.debug env (FStar_Options.Other "Gen") in if uu___3 @@ -31,7 +42,7 @@ let (gen_univs : let uu___4 = let uu___5 = FStar_TypeChecker_Env.univ_vars env in FStar_Class_Show.show - (FStar_Compiler_Set.showable_set + (FStar_Compiler_FlatSet.showable_set FStar_Syntax_Free.ord_univ_uvar showable_univ_var) uu___5 in FStar_Compiler_Util.print1 "univ_vars in env: %s\n" uu___4 else ()); @@ -66,15 +77,19 @@ let (gen_univs : let (gather_free_univnames : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.univ_name FStar_Compiler_Set.t) + FStar_Syntax_Syntax.univ_name FStar_Compiler_FlatSet.t) = fun env -> fun t -> let ctx_univnames = FStar_TypeChecker_Env.univnames env in let tm_univnames = FStar_Syntax_Free.univnames t in let univnames = - FStar_Compiler_Set.diff FStar_Syntax_Syntax.ord_ident tm_univnames - ctx_univnames in + Obj.magic + (FStar_Class_Setlike.diff () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) (Obj.magic tm_univnames) + (Obj.magic ctx_univnames)) in univnames let (check_universe_generalization : FStar_Syntax_Syntax.univ_name Prims.list -> @@ -113,7 +128,10 @@ let (generalize_universes : FStar_TypeChecker_Env.DoNotUnfoldPureLets] env t0 in let univnames = let uu___1 = gather_free_univnames env t in - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_ident uu___1 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) (Obj.magic uu___1) in (let uu___2 = FStar_TypeChecker_Env.debug env (FStar_Options.Other "Gen") in if uu___2 @@ -135,7 +153,7 @@ let (generalize_universes : then let uu___4 = FStar_Class_Show.show - (FStar_Compiler_Set.showable_set + (FStar_Compiler_FlatSet.showable_set FStar_Syntax_Free.ord_univ_uvar showable_univ_var) univs in FStar_Compiler_Util.print1 "univs to gen : %s\n" uu___4 @@ -211,9 +229,16 @@ let (gen : let env_uvars = FStar_TypeChecker_Env.uvars_in_env env in let gen_uvars uvs = let uu___2 = - FStar_Compiler_Set.diff FStar_Syntax_Free.ord_ctx_uvar uvs - env_uvars in - FStar_Compiler_Set.elems FStar_Syntax_Free.ord_ctx_uvar uu___2 in + Obj.magic + (FStar_Class_Setlike.diff () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uvs) + (Obj.magic env_uvars)) in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___2) in let univs_and_uvars_of_lec uu___2 = match uu___2 with | (lbname, e, c) -> @@ -228,12 +253,12 @@ let (gen : then let uu___5 = FStar_Class_Show.show - (FStar_Compiler_Set.showable_set + (FStar_Compiler_FlatSet.showable_set FStar_Syntax_Free.ord_univ_uvar showable_univ_var) univs in let uu___6 = FStar_Class_Show.show - (FStar_Compiler_Set.showable_set + (FStar_Compiler_FlatSet.showable_set FStar_Syntax_Free.ord_ctx_uvar FStar_Syntax_Print.showable_ctxu) uvt in FStar_Compiler_Util.print2 @@ -242,17 +267,27 @@ let (gen : else ()); (let univs1 = let uu___4 = - FStar_Compiler_Set.elems - FStar_Syntax_Free.ord_ctx_uvar uvt in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uvt) in FStar_Compiler_List.fold_left - (fun univs2 -> - fun uv -> - let uu___5 = - let uu___6 = FStar_Syntax_Util.ctx_uvar_typ uv in - FStar_Syntax_Free.univs uu___6 in - FStar_Compiler_Set.union - FStar_Syntax_Free.ord_univ_uvar univs2 uu___5) - univs uu___4 in + (fun uu___6 -> + fun uu___5 -> + (fun univs2 -> + fun uv -> + let uu___5 = + let uu___6 = + FStar_Syntax_Util.ctx_uvar_typ uv in + FStar_Syntax_Free.univs uu___6 in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) + (Obj.magic univs2) (Obj.magic uu___5))) + uu___6 uu___5) univs uu___4 in let uvs = gen_uvars uvt in (let uu___5 = FStar_TypeChecker_Env.debug env @@ -261,7 +296,7 @@ let (gen : then let uu___6 = FStar_Class_Show.show - (FStar_Compiler_Set.showable_set + (FStar_Compiler_FlatSet.showable_set FStar_Syntax_Free.ord_univ_uvar showable_univ_var) univs1 in let uu___7 = @@ -280,8 +315,11 @@ let (gen : | (univs, uvs, lec_hd) -> let force_univs_eq lec2 u1 u2 = let uu___3 = - FStar_Compiler_Set.equal FStar_Syntax_Free.ord_univ_uvar - u1 u2 in + FStar_Class_Setlike.equal () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic u1) + (Obj.magic u2) in if uu___3 then () else @@ -389,8 +427,11 @@ let (gen : FStar_Syntax_Free.names kres in let uu___9 = let uu___10 = - FStar_Compiler_Set.is_empty - FStar_Syntax_Syntax.ord_bv free in + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic free) in Prims.op_Negation uu___10 in if uu___9 then [] @@ -560,18 +601,31 @@ let (generalize' : else ()); (let univnames_lecs = let empty = - FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_ident [] in + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) []) in FStar_Compiler_List.fold_left - (fun out -> + (fun uu___3 -> fun uu___2 -> - match uu___2 with - | (l, t, c) -> - let uu___3 = gather_free_univnames env t in - FStar_Compiler_Set.union FStar_Syntax_Syntax.ord_ident - out uu___3) empty lecs in + (fun out -> + fun uu___2 -> + match uu___2 with + | (l, t, c) -> + let uu___3 = gather_free_univnames env t in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) + (Obj.magic out) (Obj.magic uu___3))) uu___3 + uu___2) empty lecs in let univnames_lecs1 = - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_ident - univnames_lecs in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) (Obj.magic univnames_lecs) in let generalized_lecs = let uu___2 = gen env is_rec lecs in match uu___2 with diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Positivity.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Positivity.ml index b1a4971caeb..797fe186c64 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Positivity.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Positivity.ml @@ -88,7 +88,10 @@ let (ty_occurs_in : fun ty_lid -> fun t -> let uu___ = FStar_Syntax_Free.fvars t in - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_fv ty_lid uu___ + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset FStar_Syntax_Syntax.ord_fv)) + ty_lid (Obj.magic uu___) let rec (term_as_fv_or_name : FStar_Syntax_Syntax.term -> ((FStar_Syntax_Syntax.fv * FStar_Syntax_Syntax.universes), diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml index d9a29550d16..075f1913578 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml @@ -78,12 +78,18 @@ let (is_base_type : | uu___2 -> false) let (binders_as_bv_set : FStar_Syntax_Syntax.binders -> - FStar_Syntax_Syntax.bv FStar_Compiler_Set.set) + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t) = - fun bs -> - let uu___ = - FStar_Compiler_List.map (fun b -> b.FStar_Syntax_Syntax.binder_bv) bs in - FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_bv uu___ + fun uu___ -> + (fun bs -> + let uu___ = + FStar_Compiler_List.map (fun b -> b.FStar_Syntax_Syntax.binder_bv) + bs in + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) uu___)) uu___ type lstring = Prims.string FStar_Thunk.t let (mklstr : (unit -> Prims.string) -> Prims.string FStar_Thunk.thunk) = fun f -> @@ -145,7 +151,7 @@ type worklist = tcenv: FStar_TypeChecker_Env.env ; wl_implicits: FStar_TypeChecker_Common.implicits ; repr_subcomp_allowed: Prims.bool ; - typeclass_variables: FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.t } + typeclass_variables: FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_RBSet.t } let (__proj__Mkworklist__item__attempting : worklist -> FStar_TypeChecker_Common.probs) = fun projectee -> @@ -219,7 +225,7 @@ let (__proj__Mkworklist__item__repr_subcomp_allowed : worklist -> Prims.bool) umax_heuristic_ok; tcenv; wl_implicits; repr_subcomp_allowed; typeclass_variables;_} -> repr_subcomp_allowed let (__proj__Mkworklist__item__typeclass_variables : - worklist -> FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.t) = + worklist -> FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_RBSet.t) = fun projectee -> match projectee with | { attempting; wl_deferred; wl_deferred_to_tac; ctr; defer_ok; smt_ok; @@ -902,12 +908,17 @@ let (hasBinders_prob : FStar_TypeChecker_Common.prob FStar_Class_Binders.hasBinders) = { FStar_Class_Binders.boundNames = - (fun prob -> - let uu___ = - let uu___1 = p_scope prob in - FStar_Compiler_List.map (fun b -> b.FStar_Syntax_Syntax.binder_bv) - uu___1 in - FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_bv uu___) + (fun uu___ -> + (fun prob -> + let uu___ = + let uu___1 = p_scope prob in + FStar_Compiler_List.map + (fun b -> b.FStar_Syntax_Syntax.binder_bv) uu___1 in + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) uu___)) uu___) } let (def_check_term_scoped_in_prob : Prims.string -> @@ -1060,7 +1071,12 @@ let (uvis_to_string : fun uvis -> (FStar_Common.string_of_list ()) (uvi_to_string env) uvis let (empty_worklist : FStar_TypeChecker_Env.env -> worklist) = fun env -> - let uu___ = FStar_Compiler_Set.empty FStar_Syntax_Free.ord_ctx_uvar () in + let uu___ = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Free.ord_ctx_uvar)) ()) in { attempting = []; wl_deferred = []; @@ -2150,9 +2166,16 @@ let (ensure_no_uvar_subst : let (no_free_uvars : FStar_Syntax_Syntax.term -> Prims.bool) = fun t -> (let uu___ = FStar_Syntax_Free.uvars t in - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_ctx_uvar uu___) && + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___)) + && (let uu___ = FStar_Syntax_Free.univs t in - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_univ_uvar uu___) + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic uu___)) let rec (may_relate_with_logical_guard : FStar_TypeChecker_Env.env -> Prims.bool -> FStar_Syntax_Syntax.typ -> Prims.bool) @@ -2428,7 +2451,10 @@ let (occurs : fun t -> let uvars = let uu___ = FStar_Syntax_Free.uvars t in - FStar_Compiler_Set.elems FStar_Syntax_Free.ord_ctx_uvar uu___ in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___) in let occurs1 = FStar_Compiler_Util.for_some (fun uv -> @@ -2467,7 +2493,10 @@ let (occurs_full : fun t -> let uvars = let uu___ = FStar_Syntax_Free.uvars_full t in - FStar_Compiler_Set.elems FStar_Syntax_Free.ord_ctx_uvar uu___ in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___) in let occurs1 = FStar_Compiler_Util.for_some (fun uv -> @@ -2650,8 +2679,11 @@ let restrict_all_uvars : binders_as_bv_set src.FStar_Syntax_Syntax.ctx_uvar_binders in let uu___ = - FStar_Compiler_Set.subset FStar_Syntax_Syntax.ord_bv - ctx_src ctx_tgt in + FStar_Class_Setlike.subset () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic ctx_src) (Obj.magic ctx_tgt) in if uu___ then wl1 else restrict_ctx env tgt [] src wl1) sources wl | uu___ -> @@ -2666,21 +2698,48 @@ let (intersect_binders : fun v1 -> fun v2 -> let as_set v = + let uu___ = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) ()) in FStar_Compiler_List.fold_left - (fun out -> - fun x -> - FStar_Compiler_Set.add FStar_Syntax_Syntax.ord_bv - x.FStar_Syntax_Syntax.binder_bv out) - FStar_Syntax_Syntax.no_names v in + (fun uu___2 -> + fun uu___1 -> + (fun out -> + fun x -> + Obj.magic + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) + x.FStar_Syntax_Syntax.binder_bv (Obj.magic out))) + uu___2 uu___1) uu___ v in let v1_set = as_set v1 in let ctx_binders = + let uu___ = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) ()) in FStar_Compiler_List.fold_left - (fun out -> - fun b -> - match b with - | FStar_Syntax_Syntax.Binding_var x -> - FStar_Compiler_Set.add FStar_Syntax_Syntax.ord_bv x out - | uu___ -> out) FStar_Syntax_Syntax.no_names g in + (fun uu___2 -> + fun uu___1 -> + (fun out -> + fun b -> + match b with + | FStar_Syntax_Syntax.Binding_var x -> + Obj.magic + (Obj.repr + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) x + (Obj.magic out))) + | uu___1 -> Obj.magic (Obj.repr out)) uu___2 uu___1) + uu___ g in let uu___ = FStar_Compiler_List.fold_left (fun uu___1 -> @@ -2694,8 +2753,11 @@ let (intersect_binders : | (x, imp) -> let uu___3 = let uu___4 = - FStar_Compiler_Set.mem - FStar_Syntax_Syntax.ord_bv x v1_set in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) x + (Obj.magic v1_set) in Prims.op_Negation uu___4 in if uu___3 then (isect, isect_set) @@ -2704,13 +2766,20 @@ let (intersect_binders : FStar_Syntax_Free.names x.FStar_Syntax_Syntax.sort in let uu___5 = - FStar_Compiler_Set.subset - FStar_Syntax_Syntax.ord_bv fvs isect_set in + FStar_Class_Setlike.subset () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic fvs) (Obj.magic isect_set) in if uu___5 then let uu___6 = - FStar_Compiler_Set.add - FStar_Syntax_Syntax.ord_bv x isect_set in + Obj.magic + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) x + (Obj.magic isect_set)) in ((b :: isect), uu___6) else (isect, isect_set)))) ([], ctx_binders) v2 in match uu___ with | (isect, uu___1) -> FStar_Compiler_List.rev isect @@ -4987,10 +5056,13 @@ let (has_typeclass_constraint : FStar_Syntax_Syntax.ctx_uvar -> worklist -> Prims.bool) = fun u -> fun wl -> - FStar_Compiler_Set.for_any FStar_Syntax_Free.ord_ctx_uvar + FStar_Class_Setlike.for_any () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset FStar_Syntax_Free.ord_ctx_uvar)) (fun v -> FStar_Syntax_Unionfind.equiv v.FStar_Syntax_Syntax.ctx_uvar_head - u.FStar_Syntax_Syntax.ctx_uvar_head) wl.typeclass_variables + u.FStar_Syntax_Syntax.ctx_uvar_head) + (Obj.magic wl.typeclass_variables) let (lazy_complete_repr : FStar_Syntax_Syntax.lazy_kind -> Prims.bool) = fun k -> match k with @@ -5007,7 +5079,10 @@ let (has_free_uvars : FStar_Syntax_Syntax.term -> Prims.bool) = fun t -> let uu___ = let uu___1 = FStar_Syntax_Free.uvars_uncached t in - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_ctx_uvar uu___1 in + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___1) in Prims.op_Negation uu___ let (env_has_free_uvars : FStar_TypeChecker_Env.env_t -> Prims.bool) = fun e -> @@ -6727,8 +6802,11 @@ and (solve_t_flex_rigid_eq : let uu___7 = FStar_Syntax_Free.names (FStar_Pervasives_Native.fst arg) in - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv x - uu___7 in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) x + (Obj.magic uu___7) in Prims.op_Negation uu___6 in let bv_not_free_in_args x args1 = FStar_Compiler_Util.for_all (bv_not_free_in_arg x) @@ -6833,9 +6911,12 @@ and (solve_t_flex_rigid_eq : let fvs_rhs = FStar_Syntax_Free.names rhs1 in let uu___9 = let uu___10 = - FStar_Compiler_Set.subset - FStar_Syntax_Syntax.ord_bv fvs_rhs - fvs_lhs in + FStar_Class_Setlike.subset () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic fvs_rhs) + (Obj.magic fvs_lhs) in Prims.op_Negation uu___10 in if uu___9 then @@ -7169,9 +7250,12 @@ and (solve_t_flex_rigid_eq : let uu___14 = binders_as_bv_set ctx_uv.FStar_Syntax_Syntax.ctx_uvar_binders in - FStar_Compiler_Set.subset - FStar_Syntax_Syntax.ord_bv - uu___13 uu___14 in + FStar_Class_Setlike.subset () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic uu___13) + (Obj.magic uu___14) in Prims.op_Negation uu___12 in if uu___11 then @@ -7498,9 +7582,13 @@ and (solve_t_flex_rigid_eq : let uu___20 = FStar_Syntax_Free.uvars head1 in - FStar_Compiler_Set.elems - FStar_Syntax_Free.ord_ctx_uvar - uu___20 in + FStar_Class_Setlike.elems + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic + uu___20) in solve_sub_probs_if_head_types_equal uu___19 wl2 | FStar_Pervasives.Inr @@ -7568,8 +7656,11 @@ and (solve_t_flex_rigid_eq : uu___7 else (let uu___8 = - FStar_Compiler_Set.subset - FStar_Syntax_Syntax.ord_bv fvs2 fvs1 in + FStar_Class_Setlike.subset () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic fvs2) (Obj.magic fvs1) in if uu___8 then let sol = @@ -7590,13 +7681,13 @@ and (solve_t_flex_rigid_eq : (fun uu___10 -> let uu___11 = FStar_Class_Show.show - (FStar_Compiler_Set.showable_set + (FStar_Compiler_FlatSet.showable_set FStar_Syntax_Syntax.ord_bv FStar_Syntax_Print.showable_bv) fvs2 in let uu___12 = FStar_Class_Show.show - (FStar_Compiler_Set.showable_set + (FStar_Compiler_FlatSet.showable_set FStar_Syntax_Syntax.ord_bv FStar_Syntax_Print.showable_bv) fvs1 in @@ -9638,16 +9729,20 @@ and (solve_t' : tprob -> worklist -> solution) = (let uu___12 = let uu___13 = FStar_Syntax_Free.uvars phi12 in - FStar_Compiler_Set.is_empty - FStar_Syntax_Free.ord_ctx_uvar - uu___13 in + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___13) in Prims.op_Negation uu___12) || (let uu___12 = let uu___13 = FStar_Syntax_Free.uvars phi22 in - FStar_Compiler_Set.is_empty - FStar_Syntax_Free.ord_ctx_uvar - uu___13 in + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___13) in Prims.op_Negation uu___12) in if (problem.FStar_TypeChecker_Common.relation @@ -14052,14 +14147,19 @@ let (try_solve_deferred_constraints : i.FStar_TypeChecker_Common.imp_uvar in let uvs = FStar_Syntax_Free.uvars goal_type in - FStar_Compiler_Set.elems - FStar_Syntax_Free.ord_ctx_uvar - uvs + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uvs) else []) | uu___4 -> []) g.FStar_TypeChecker_Common.implicits in - FStar_Compiler_Set.from_list - FStar_Syntax_Free.ord_ctx_uvar uu___3 in + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Free.ord_ctx_uvar)) uu___3) in let wl = let uu___3 = wl_of_guard env g.FStar_TypeChecker_Common.deferred in @@ -15113,10 +15213,14 @@ let (is_tac_implicit_resolved : fun env -> fun i -> let uu___ = FStar_Syntax_Free.uvars i.FStar_TypeChecker_Common.imp_tm in - FStar_Compiler_Set.for_all FStar_Syntax_Free.ord_ctx_uvar + FStar_Class_Setlike.for_all () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (fun uv -> let uu___1 = FStar_Syntax_Util.ctx_uvar_should_check uv in - FStar_Syntax_Syntax.uu___is_Allow_unresolved uu___1) uu___ + FStar_Syntax_Syntax.uu___is_Allow_unresolved uu___1) + (Obj.magic uu___) let (resolve_implicits' : FStar_TypeChecker_Env.env -> Prims.bool -> diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml index 6ad32cd8636..b0c708e79e5 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml @@ -1852,9 +1852,11 @@ let (tc_sig_let : let uu___11 = FStar_Syntax_Free.fvars lb.FStar_Syntax_Syntax.lbtyp in - FStar_Compiler_Set.elems - FStar_Syntax_Syntax.ord_fv - uu___11 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_fv)) + (Obj.magic uu___11) in FStar_Compiler_List.tryFind (fun lid -> let uu___11 = diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml index 6d10584120e..aeadfe2bf63 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml @@ -264,8 +264,11 @@ let (check_no_escape : let uu___2 = FStar_Compiler_List.tryFind (fun x -> - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv - x fvs') fvs in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) x + (Obj.magic fvs')) fvs in match uu___2 with | FStar_Pervasives_Native.None -> (t1, FStar_TypeChecker_Env.trivial_guard) @@ -872,65 +875,95 @@ let (print_expected_ty : FStar_TypeChecker_Env.env -> unit) = let rec (get_pat_vars' : FStar_Syntax_Syntax.bv Prims.list -> Prims.bool -> - FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.t) + FStar_Syntax_Syntax.term -> + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t) = - fun all -> - fun andlist -> - fun pats -> - let pats1 = FStar_Syntax_Util.unmeta pats in - let uu___ = FStar_Syntax_Util.head_and_args pats1 in - match uu___ with - | (head, args) -> - let uu___1 = - let uu___2 = - let uu___3 = FStar_Syntax_Util.un_uinst head in - uu___3.FStar_Syntax_Syntax.n in - (uu___2, args) in - (match uu___1 with - | (FStar_Syntax_Syntax.Tm_fvar fv, uu___2) when - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.nil_lid - -> - if andlist - then - FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_bv - all - else FStar_Compiler_Set.empty FStar_Syntax_Syntax.ord_bv () - | (FStar_Syntax_Syntax.Tm_fvar fv, - (uu___2, FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.aqual_implicit = true; - FStar_Syntax_Syntax.aqual_attributes = uu___3;_}):: - (hd, FStar_Pervasives_Native.None)::(tl, - FStar_Pervasives_Native.None)::[]) - when - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.cons_lid - -> - let hdvs = get_pat_vars' all false hd in - let tlvs = get_pat_vars' all andlist tl in - if andlist - then - FStar_Compiler_Set.inter FStar_Syntax_Syntax.ord_bv hdvs - tlvs - else - FStar_Compiler_Set.union FStar_Syntax_Syntax.ord_bv hdvs - tlvs - | (FStar_Syntax_Syntax.Tm_fvar fv, - (uu___2, FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.aqual_implicit = true; - FStar_Syntax_Syntax.aqual_attributes = uu___3;_}):: - (pat, FStar_Pervasives_Native.None)::[]) when - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.smtpat_lid - -> FStar_Syntax_Free.names pat - | (FStar_Syntax_Syntax.Tm_fvar fv, - (subpats, FStar_Pervasives_Native.None)::[]) when - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.smtpatOr_lid - -> get_pat_vars' all true subpats - | uu___2 -> - FStar_Compiler_Set.empty FStar_Syntax_Syntax.ord_bv ()) + fun uu___2 -> + fun uu___1 -> + fun uu___ -> + (fun all -> + fun andlist -> + fun pats -> + let pats1 = FStar_Syntax_Util.unmeta pats in + let uu___ = FStar_Syntax_Util.head_and_args pats1 in + match uu___ with + | (head, args) -> + let uu___1 = + let uu___2 = + let uu___3 = FStar_Syntax_Util.un_uinst head in + uu___3.FStar_Syntax_Syntax.n in + (uu___2, args) in + (match uu___1 with + | (FStar_Syntax_Syntax.Tm_fvar fv, uu___2) when + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.nil_lid + -> + Obj.magic + (Obj.repr + (if andlist + then + FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) all + else + FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) ())) + | (FStar_Syntax_Syntax.Tm_fvar fv, + (uu___2, FStar_Pervasives_Native.Some + { FStar_Syntax_Syntax.aqual_implicit = true; + FStar_Syntax_Syntax.aqual_attributes = uu___3;_}):: + (hd, FStar_Pervasives_Native.None)::(tl, + FStar_Pervasives_Native.None)::[]) + when + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.cons_lid + -> + Obj.magic + (Obj.repr + (let hdvs = get_pat_vars' all false hd in + let tlvs = get_pat_vars' all andlist tl in + if andlist + then + FStar_Class_Setlike.inter () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic hdvs) (Obj.magic tlvs) + else + FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic hdvs) (Obj.magic tlvs))) + | (FStar_Syntax_Syntax.Tm_fvar fv, + (uu___2, FStar_Pervasives_Native.Some + { FStar_Syntax_Syntax.aqual_implicit = true; + FStar_Syntax_Syntax.aqual_attributes = uu___3;_}):: + (pat, FStar_Pervasives_Native.None)::[]) when + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.smtpat_lid + -> Obj.magic (Obj.repr (FStar_Syntax_Free.names pat)) + | (FStar_Syntax_Syntax.Tm_fvar fv, + (subpats, FStar_Pervasives_Native.None)::[]) when + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.smtpatOr_lid + -> + Obj.magic (Obj.repr (get_pat_vars' all true subpats)) + | uu___2 -> + Obj.magic + (Obj.repr + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) ())))) + uu___2 uu___1 uu___ let (get_pat_vars : FStar_Syntax_Syntax.bv Prims.list -> - FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.t) + FStar_Syntax_Syntax.term -> + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t) = fun all -> fun pats -> get_pat_vars' all false pats let (check_pat_fvs : FStar_Compiler_Range_Type.range -> @@ -959,8 +992,11 @@ let (check_pat_fvs : FStar_Syntax_Syntax.binder_positivity = uu___3; FStar_Syntax_Syntax.binder_attrs = uu___4;_} -> let uu___5 = - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv b - pat_vars in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) b + (Obj.magic pat_vars) in Prims.op_Negation uu___5) bs in match uu___ with | FStar_Pervasives_Native.None -> () @@ -6661,11 +6697,17 @@ and (check_application_args : if uu___1 then let uu___2 = - FStar_Compiler_Range_Ops.string_of_range + FStar_Class_Show.show FStar_Compiler_Range_Ops.show_range head.FStar_Syntax_Syntax.pos in - let uu___3 = FStar_Syntax_Print.term_to_string thead in - FStar_Compiler_Util.print2 "(%s) Type of head is %s\n" - uu___2 uu___3 + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term + thead in + let uu___4 = + FStar_Class_Show.show FStar_Syntax_Print.showable_args + args in + FStar_Compiler_Util.print3 + "(%s) Type of head is %s\nArgs = %s\n" uu___2 uu___3 + uu___4 else ()); (let monadic_application uu___1 subst arg_comps_rev arg_rets_rev guard fvs bs = @@ -7091,15 +7133,18 @@ and (check_application_args : = let uu___18 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e in let uu___19 = - FStar_Ident.string_of_lid + FStar_Class_Show.show + FStar_Ident.showable_lident c.FStar_TypeChecker_Common.eff_name in let uu___20 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term head1 in FStar_Compiler_Util.format3 "Effectful argument %s (%s) to erased function %s, consider let binding it" @@ -7268,7 +7313,8 @@ and (check_application_args : if uu___10 then let uu___11 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term app in let uu___12 = FStar_TypeChecker_Common.lcomp_to_string @@ -7517,16 +7563,24 @@ and (check_application_args : FStar_Options.Extreme in if uu___4 then - let uu___5 = FStar_Syntax_Print.bv_to_string x1 in + let uu___5 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv x1 in let uu___6 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term x1.FStar_Syntax_Syntax.sort in let uu___7 = - FStar_Syntax_Print.term_to_string e in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e in let uu___8 = - FStar_Syntax_Print.subst_to_string subst in + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Syntax_Print.showable_subst_elt) + subst in let uu___9 = - FStar_Syntax_Print.term_to_string targ in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term targ in FStar_Compiler_Util.print5 "\tFormal is %s : %s\tType of arg %s (after subst %s) = %s\n" uu___5 uu___6 uu___7 uu___8 uu___9 @@ -11039,9 +11093,13 @@ and (check_inner_let_rec : if uu___6 then let bvss = - FStar_Compiler_Set.from_list - FStar_Syntax_Syntax.ord_bv - bvs in + Obj.magic + (FStar_Class_Setlike.from_list + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + bvs) in FStar_TypeChecker_Common.apply_lcomp (fun c -> let uu___7 = @@ -11057,13 +11115,23 @@ and (check_inner_let_rec : let uu___13 = FStar_Syntax_Free.names t in - FStar_Compiler_Set.inter - FStar_Syntax_Syntax.ord_bv - bvss - uu___13 in - FStar_Compiler_Set.is_empty - FStar_Syntax_Syntax.ord_bv - uu___12 in + Obj.magic + (FStar_Class_Setlike.inter + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic + bvss) + (Obj.magic + uu___13)) in + FStar_Class_Setlike.is_empty + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic + uu___12) in Prims.op_Negation uu___11) uu___8 in if uu___7 diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml index 1e54853ffc9..3c638a5388f 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml @@ -107,7 +107,10 @@ let (check_uvars : let uvs = FStar_Syntax_Free.uvars t in let uu___ = let uu___1 = - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_ctx_uvar uvs in + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uvs) in Prims.op_Negation uu___1 in if uu___ then @@ -118,7 +121,7 @@ let (check_uvars : let uu___6 = let uu___7 = FStar_Class_Show.show - (FStar_Compiler_Set.showable_set + (FStar_Compiler_FlatSet.showable_set FStar_Syntax_Free.ord_ctx_uvar FStar_Syntax_Print.showable_ctxu) uvs in let uu___8 = @@ -5168,8 +5171,11 @@ let rec (check_erased : let uu___11 = let uu___12 = FStar_Syntax_Free.names br_body in - FStar_Compiler_Set.elems - FStar_Syntax_Syntax.ord_bv uu___12 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic uu___12) in FStar_TypeChecker_Env.push_bvs env uu___11 in check_erased uu___10 br_body in @@ -6460,14 +6466,18 @@ let (maybe_instantiate : ((let uu___2 = FStar_TypeChecker_Env.debug env FStar_Options.High in if uu___2 then - let uu___3 = FStar_Syntax_Print.term_to_string e in - let uu___4 = FStar_Syntax_Print.term_to_string t in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term e in + let uu___4 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t in let uu___5 = let uu___6 = FStar_TypeChecker_Env.expected_typ env in - match uu___6 with - | FStar_Pervasives_Native.None -> "None" - | FStar_Pervasives_Native.Some (t1, uu___7) -> - FStar_Syntax_Print.term_to_string t1 in + FStar_Class_Show.show + (FStar_Class_Show.show_option + (FStar_Class_Show.show_tuple2 + FStar_Syntax_Print.showable_term + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool))) uu___6 in FStar_Compiler_Util.print3 "maybe_instantiate: starting check for (%s) of type (%s), expected type is %s\n" uu___3 uu___4 uu___5 @@ -6599,7 +6609,8 @@ let (maybe_instantiate : if uu___9 then let uu___10 = - FStar_Syntax_Print.term_to_string v in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term v in FStar_Compiler_Util.print1 "maybe_instantiate: Instantiating implicit with %s\n" uu___10 @@ -6660,7 +6671,8 @@ let (maybe_instantiate : if uu___8 then let uu___9 = - FStar_Syntax_Print.term_to_string v in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term v in FStar_Compiler_Util.print1 "maybe_instantiate: Instantiating meta argument with %s\n" uu___9 diff --git a/ocaml/fstar-tests/generated/FStar_Tests_Data.ml b/ocaml/fstar-tests/generated/FStar_Tests_Data.ml new file mode 100644 index 00000000000..d6a09bb0f9f --- /dev/null +++ b/ocaml/fstar-tests/generated/FStar_Tests_Data.ml @@ -0,0 +1,106 @@ +open Prims +let rec insert : + 'set . + Prims.int -> + (Prims.int, 'set) FStar_Class_Setlike.setlike -> 'set -> 'set + = + fun n -> + fun uu___ -> + fun s -> + if n = Prims.int_zero + then s + else + (let uu___2 = + Obj.magic + (FStar_Class_Setlike.add () (Obj.magic uu___) n (Obj.magic s)) in + insert (n - Prims.int_one) uu___ uu___2) +let rec all_mem : + 'set . + Prims.int -> + (Prims.int, 'set) FStar_Class_Setlike.setlike -> 'set -> Prims.bool + = + fun n -> + fun uu___ -> + fun s -> + if n = Prims.int_zero + then true + else + (FStar_Class_Setlike.mem () (Obj.magic uu___) n (Obj.magic s)) && + (all_mem (n - Prims.int_one) uu___ s) +let (nn : Prims.int) = (Prims.of_int (50000)) +let (run_all : unit -> unit) = + fun uu___ -> + FStar_Compiler_Util.print_string "data tests\n"; + (let uu___2 = + FStar_Compiler_Util.record_time + (fun uu___3 -> + let uu___4 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Class_Ord.ord_int)) ()) in + insert nn + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Class_Ord.ord_int) uu___4) in + match uu___2 with + | (f, ms) -> + ((let uu___4 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) ms in + FStar_Compiler_Util.print1 "FlatSet insert: %s\n" uu___4); + (let uu___4 = + FStar_Compiler_Util.record_time + (fun uu___5 -> + all_mem nn + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Class_Ord.ord_int) f) in + match uu___4 with + | (f_ok, ms1) -> + ((let uu___6 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) ms1 in + FStar_Compiler_Util.print1 "FlatSet all_mem: %s\n" uu___6); + if Prims.op_Negation f_ok + then FStar_Compiler_Effect.failwith "FlatSet all_mem failed" + else (); + (let uu___7 = + FStar_Compiler_Util.record_time + (fun uu___8 -> + let uu___9 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_int)) ()) in + insert nn + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_int) uu___9) in + match uu___7 with + | (rb, ms2) -> + ((let uu___9 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) ms2 in + FStar_Compiler_Util.print1 "RBSet insert: %s\n" uu___9); + (let uu___9 = + FStar_Compiler_Util.record_time + (fun uu___10 -> + all_mem nn + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_int) rb) in + match uu___9 with + | (rb_ok, ms3) -> + ((let uu___11 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) ms3 in + FStar_Compiler_Util.print1 "RBSet all_mem: %s\n" + uu___11); + if Prims.op_Negation rb_ok + then + FStar_Compiler_Effect.failwith + "RBSet all_mem failed" + else ())))))))) \ No newline at end of file diff --git a/ocaml/fstar-tests/generated/FStar_Tests_Test.ml b/ocaml/fstar-tests/generated/FStar_Tests_Test.ml index 51943f3372f..37482c0ceea 100644 --- a/ocaml/fstar-tests/generated/FStar_Tests_Test.ml +++ b/ocaml/fstar-tests/generated/FStar_Tests_Test.ml @@ -26,6 +26,7 @@ let main : 'uuuuu 'uuuuu1 . 'uuuuu -> 'uuuuu1 = if uu___8 then () else FStar_Compiler_Effect.exit Prims.int_one); + FStar_Tests_Data.run_all (); FStar_Compiler_Effect.exit Prims.int_zero) | FStar_Getopt.Success -> (FStar_Main.setup_hooks (); @@ -36,6 +37,7 @@ let main : 'uuuuu 'uuuuu1 . 'uuuuu -> 'uuuuu1 = if uu___8 then () else FStar_Compiler_Effect.exit Prims.int_one); + FStar_Tests_Data.run_all (); FStar_Compiler_Effect.exit Prims.int_zero)))) () with | FStar_Errors.Error (err, msg, r, _ctx) when From 630aadda643b2145146d9ce66a338b4352241b84 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Wed, 24 Apr 2024 12:57:08 -0700 Subject: [PATCH 083/239] try revise pretyping axiom --- .../generated/FStar_SMTEncoding_Encode.ml | 13 +++++++++++-- .../generated/FStar_SMTEncoding_Term.ml | 17 +++++++++++------ src/smtencoding/FStar.SMTEncoding.Encode.fst | 3 ++- 3 files changed, 24 insertions(+), 9 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index 055e9d7c871..85b8263ece0 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -746,8 +746,17 @@ let (pretype_axiom : let uu___9 = let uu___10 = FStar_SMTEncoding_Util.mkApp - ("PreType", [xx]) in - (tapp, uu___10) in + ("Term_constr_id", [tapp]) in + let uu___11 = + let uu___12 = + let uu___13 = + let uu___14 = + FStar_SMTEncoding_Util.mkApp + ("PreType", [xx]) in + [uu___14] in + ("Term_constr_id", uu___13) in + FStar_SMTEncoding_Util.mkApp uu___12 in + (uu___10, uu___11) in FStar_SMTEncoding_Util.mkEq uu___9 in (xx_has_type, uu___8) in FStar_SMTEncoding_Util.mkImp uu___7 in diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml index 7066a54054f..c19788222e9 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml @@ -542,12 +542,17 @@ let (fv_eq : fv -> fv -> Prims.bool) = let (fvs_subset_of : fvs -> fvs -> Prims.bool) = fun x -> fun y -> - let cmp_fv x1 y1 = - let uu___ = fv_name x1 in - let uu___1 = fv_name y1 in FStar_Compiler_Util.compare uu___ uu___1 in - let uu___ = FStar_Compiler_Set.from_list ord_fv x in - let uu___1 = FStar_Compiler_Set.from_list ord_fv y in - FStar_Compiler_Set.subset ord_fv uu___ uu___1 + let uu___ = + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic (FStar_Compiler_RBSet.setlike_rbset ord_fv)) x) in + let uu___1 = + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic (FStar_Compiler_RBSet.setlike_rbset ord_fv)) y) in + FStar_Class_Setlike.subset () + (Obj.magic (FStar_Compiler_RBSet.setlike_rbset ord_fv)) + (Obj.magic uu___) (Obj.magic uu___1) let (freevar_eq : term -> term -> Prims.bool) = fun x -> fun y -> diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index b3ae7d55d87..7ce6a13c8b2 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -175,7 +175,8 @@ let pretype_axiom rng env tapp vars = let tapp_hash = Term.hash_of_term tapp in let module_name = env.current_module_name in Util.mkAssume(mkForall rng ([[xx_has_type]], mk_fv (xxsym, Term_sort)::mk_fv (ffsym, Fuel_sort)::vars, - mkImp(xx_has_type, mkEq(tapp, mkApp("PreType", [xx])))), + mkImp(xx_has_type, mkEq(mkApp ("Term_constr_id", [tapp]), + mkApp ("Term_constr_id", [mkApp("PreType", [xx])])))), Some "pretyping", (varops.mk_unique (module_name ^ "_pretyping_" ^ (BU.digest_of_string tapp_hash)))) From 4bb0bfb66605bf957381f829bc06fdf061d244ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 24 Apr 2024 13:24:02 -0700 Subject: [PATCH 084/239] RBSet: fix in deletion --- src/data/FStar.Compiler.RBSet.fst | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/data/FStar.Compiler.RBSet.fst b/src/data/FStar.Compiler.RBSet.fst index fd66fa9c78c..7f74063e05b 100644 --- a/src/data/FStar.Compiler.RBSet.fst +++ b/src/data/FStar.Compiler.RBSet.fst @@ -62,8 +62,7 @@ let add {| ord 'a |} (x:'a) (s:rbset 'a) : rbset 'a = let rec extract_min #a {| ord a |} (t : rbset a{N? t}) : rbset a & a = match t with - | N (_, L, x, L) -> L, x - | N (c, N (_, L, x, L), y, L) -> N (B, L, x, L), y + | N (_, L, x, r) -> r, x | N (c, a, x, b) -> let (a', y) = extract_min a in balance c a' x b, y From 9a657a61af18e57c90faa7ca70d2f369104ff3dc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 24 Apr 2024 13:24:12 -0700 Subject: [PATCH 085/239] More tests --- src/tests/FStar.Tests.Data.fst | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/src/tests/FStar.Tests.Data.fst b/src/tests/FStar.Tests.Data.fst index 27ee0e674c0..01be3b858a2 100644 --- a/src/tests/FStar.Tests.Data.fst +++ b/src/tests/FStar.Tests.Data.fst @@ -36,7 +36,11 @@ let rec all_mem (n:int) {| setlike int 'set |} (s : 'set) = if n = 0 then true else mem n s && all_mem (n-1) s -let nn = 50000 +let rec all_remove (n:int) {| setlike int 'set |} (s : 'set) = + if n = 0 then s + else all_remove (n-1) (remove n s) + +let nn = 10000 let run_all () = BU.print_string "data tests\n"; @@ -44,11 +48,19 @@ let run_all () = BU.print1 "FlatSet insert: %s\n" (show ms); let (f_ok, ms) = BU.record_time (fun () -> all_mem nn f) in BU.print1 "FlatSet all_mem: %s\n" (show ms); + let (f, ms) = BU.record_time (fun () -> all_remove nn f) in + BU.print1 "FlatSet all_remove: %s\n" (show ms); + if not f_ok then failwith "FlatSet all_mem failed"; + if not (is_empty f) then failwith "FlatSet all_remove failed"; let (rb, ms) = BU.record_time (fun () -> insert nn (empty () <: RBSet.t int)) in BU.print1 "RBSet insert: %s\n" (show ms); let (rb_ok, ms) = BU.record_time (fun () -> all_mem nn rb) in BU.print1 "RBSet all_mem: %s\n" (show ms); + let (rb, ms) = BU.record_time (fun () -> all_remove nn rb) in + BU.print1 "RBSet all_remove: %s\n" (show ms); + if not rb_ok then failwith "RBSet all_mem failed"; + if not (is_empty rb) then failwith "RBSet all_remove failed"; () From 8ec379b4083c5e96531977d4563f887f8e53ded4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 24 Apr 2024 13:24:26 -0700 Subject: [PATCH 086/239] snap --- .../generated/FStar_Compiler_RBSet.ml | 3 +- .../fstar-tests/generated/FStar_Tests_Data.ml | 140 +++++++++++++----- 2 files changed, 108 insertions(+), 35 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Compiler_RBSet.ml b/ocaml/fstar-lib/generated/FStar_Compiler_RBSet.ml index 8031fabbff8..ced3d3439b8 100644 --- a/ocaml/fstar-lib/generated/FStar_Compiler_RBSet.ml +++ b/ocaml/fstar-lib/generated/FStar_Compiler_RBSet.ml @@ -60,8 +60,7 @@ let rec extract_min : fun uu___ -> fun t1 -> match t1 with - | N (uu___1, L, x, L) -> (L, x) - | N (c, N (uu___1, L, x, L), y, L) -> ((N (B, L, x, L)), y) + | N (uu___1, L, x, r) -> (r, x) | N (c, a1, x, b) -> let uu___1 = extract_min uu___ a1 in (match uu___1 with | (a', y) -> ((balance c a' x b), y)) diff --git a/ocaml/fstar-tests/generated/FStar_Tests_Data.ml b/ocaml/fstar-tests/generated/FStar_Tests_Data.ml index d6a09bb0f9f..c31ecd1a8eb 100644 --- a/ocaml/fstar-tests/generated/FStar_Tests_Data.ml +++ b/ocaml/fstar-tests/generated/FStar_Tests_Data.ml @@ -27,7 +27,23 @@ let rec all_mem : else (FStar_Class_Setlike.mem () (Obj.magic uu___) n (Obj.magic s)) && (all_mem (n - Prims.int_one) uu___ s) -let (nn : Prims.int) = (Prims.of_int (50000)) +let rec all_remove : + 'set . + Prims.int -> + (Prims.int, 'set) FStar_Class_Setlike.setlike -> 'set -> 'set + = + fun n -> + fun uu___ -> + fun s -> + if n = Prims.int_zero + then s + else + (let uu___2 = + Obj.magic + (FStar_Class_Setlike.remove () (Obj.magic uu___) n + (Obj.magic s)) in + all_remove (n - Prims.int_one) uu___ uu___2) +let (nn : Prims.int) = (Prims.of_int (10000)) let (run_all : unit -> unit) = fun uu___ -> FStar_Compiler_Util.print_string "data tests\n"; @@ -63,44 +79,102 @@ let (run_all : unit -> unit) = (FStar_Class_Show.printableshow FStar_Class_Printable.printable_int) ms1 in FStar_Compiler_Util.print1 "FlatSet all_mem: %s\n" uu___6); - if Prims.op_Negation f_ok - then FStar_Compiler_Effect.failwith "FlatSet all_mem failed" - else (); - (let uu___7 = + (let uu___6 = FStar_Compiler_Util.record_time - (fun uu___8 -> - let uu___9 = - Obj.magic - (FStar_Class_Setlike.empty () - (Obj.magic - (FStar_Compiler_RBSet.setlike_rbset - FStar_Class_Ord.ord_int)) ()) in - insert nn - (FStar_Compiler_RBSet.setlike_rbset - FStar_Class_Ord.ord_int) uu___9) in - match uu___7 with - | (rb, ms2) -> - ((let uu___9 = + (fun uu___7 -> + all_remove nn + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Class_Ord.ord_int) f) in + match uu___6 with + | (f1, ms2) -> + ((let uu___8 = FStar_Class_Show.show (FStar_Class_Show.printableshow FStar_Class_Printable.printable_int) ms2 in - FStar_Compiler_Util.print1 "RBSet insert: %s\n" uu___9); - (let uu___9 = + FStar_Compiler_Util.print1 "FlatSet all_remove: %s\n" + uu___8); + if Prims.op_Negation f_ok + then + FStar_Compiler_Effect.failwith + "FlatSet all_mem failed" + else (); + (let uu___10 = + let uu___11 = + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Class_Ord.ord_int)) (Obj.magic f1) in + Prims.op_Negation uu___11 in + if uu___10 + then + FStar_Compiler_Effect.failwith + "FlatSet all_remove failed" + else ()); + (let uu___10 = FStar_Compiler_Util.record_time - (fun uu___10 -> - all_mem nn + (fun uu___11 -> + let uu___12 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_int)) ()) in + insert nn (FStar_Compiler_RBSet.setlike_rbset - FStar_Class_Ord.ord_int) rb) in - match uu___9 with - | (rb_ok, ms3) -> - ((let uu___11 = + FStar_Class_Ord.ord_int) uu___12) in + match uu___10 with + | (rb, ms3) -> + ((let uu___12 = FStar_Class_Show.show (FStar_Class_Show.printableshow FStar_Class_Printable.printable_int) ms3 in - FStar_Compiler_Util.print1 "RBSet all_mem: %s\n" - uu___11); - if Prims.op_Negation rb_ok - then - FStar_Compiler_Effect.failwith - "RBSet all_mem failed" - else ())))))))) \ No newline at end of file + FStar_Compiler_Util.print1 "RBSet insert: %s\n" + uu___12); + (let uu___12 = + FStar_Compiler_Util.record_time + (fun uu___13 -> + all_mem nn + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_int) rb) in + match uu___12 with + | (rb_ok, ms4) -> + ((let uu___14 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) + ms4 in + FStar_Compiler_Util.print1 + "RBSet all_mem: %s\n" uu___14); + (let uu___14 = + FStar_Compiler_Util.record_time + (fun uu___15 -> + all_remove nn + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_int) rb) in + match uu___14 with + | (rb1, ms5) -> + ((let uu___16 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) + ms5 in + FStar_Compiler_Util.print1 + "RBSet all_remove: %s\n" uu___16); + if Prims.op_Negation rb_ok + then + FStar_Compiler_Effect.failwith + "RBSet all_mem failed" + else (); + (let uu___18 = + let uu___19 = + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_int)) + (Obj.magic rb1) in + Prims.op_Negation uu___19 in + if uu___18 + then + FStar_Compiler_Effect.failwith + "RBSet all_remove failed" + else ()))))))))))))) \ No newline at end of file From 600963d0d191cbfcab87a62d36dd24e2a0770a49 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Wed, 24 Apr 2024 15:37:08 -0700 Subject: [PATCH 087/239] temporary admits --- ulib/LowStar.Monotonic.Buffer.fst | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/ulib/LowStar.Monotonic.Buffer.fst b/ulib/LowStar.Monotonic.Buffer.fst index 9e270442c43..97d428f670f 100644 --- a/ulib/LowStar.Monotonic.Buffer.fst +++ b/ulib/LowStar.Monotonic.Buffer.fst @@ -233,7 +233,7 @@ let live_same_addresses_equal_types_and_preorders' = Heap.lemma_distinct_addrs_distinct_preorders (); Heap.lemma_distinct_addrs_distinct_mm (); let s1 : Seq.seq a1 = as_seq h b1 in - assert (Seq.seq a1 == Seq.seq a2); + assume (Seq.seq a1 == Seq.seq a2); let s1' : Seq.seq a2 = coerce_eq _ s1 in assert (s1 === s1'); lemma_equal_instances_implies_equal_types a1 a2 s1 s1' @@ -1141,7 +1141,7 @@ let modifies_loc_buffer_from_to_intro' #a #rrel #rel b from to l h h' = // prove that the types, rrels, rels are equal Heap.lemma_distinct_addrs_distinct_preorders (); Heap.lemma_distinct_addrs_distinct_mm (); - assert (Seq.seq t' == Seq.seq a); + assume (Seq.seq t' == Seq.seq a); let _s0 : Seq.seq a = as_seq h b in let _s1 : Seq.seq t' = coerce_eq _ _s0 in lemma_equal_instances_implies_equal_types a t' _s0 _s1; @@ -1332,6 +1332,7 @@ let g_upd_seq_as_seq #a #_ #_ b s h = // prove modifies_1_preserves_ubuffers Heap.lemma_distinct_addrs_distinct_preorders (); Heap.lemma_distinct_addrs_distinct_mm (); + admit(); s_lemma_equal_instances_implies_equal_types (); modifies_1_modifies b h h' end @@ -1342,6 +1343,7 @@ let g_upd_modifies_strong #_ #_ #_ b i v h = Heap.lemma_distinct_addrs_distinct_preorders (); Heap.lemma_distinct_addrs_distinct_mm (); s_lemma_equal_instances_implies_equal_types (); + admit(); modifies_1_from_to_modifies b (U32.uint_to_t i) (U32.uint_to_t (i + 1)) h h' #pop-options From 8b9d42008c9e5e2adb8d73efb4e6ac37db1a90f6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 24 Apr 2024 15:49:28 -0700 Subject: [PATCH 088/239] Tactics: make mapply a plugin --- ulib/FStar.Tactics.MApply.fst | 31 +++-------------------------- ulib/FStar.Tactics.MApply.fsti | 36 ++++++++++++++++++++++++++++++++++ 2 files changed, 39 insertions(+), 28 deletions(-) create mode 100644 ulib/FStar.Tactics.MApply.fsti diff --git a/ulib/FStar.Tactics.MApply.fst b/ulib/FStar.Tactics.MApply.fst index b0ca0f98606..973b55e9a5f 100644 --- a/ulib/FStar.Tactics.MApply.fst +++ b/ulib/FStar.Tactics.MApply.fst @@ -11,18 +11,8 @@ open FStar.Tactics.V2.Derived open FStar.Tactics.V2.SyntaxCoercions open FStar.Tactics.Typeclasses - -private val push1 : (#p:Type) -> (#q:Type) -> - squash (p ==> q) -> - squash p -> - squash q -private let push1 #p #q f u = () - -private val push1' : (#p:Type) -> (#q:Type) -> - (p ==> q) -> - squash p -> - squash q -private let push1' #p #q f u = () +let push1 #p #q f u = () +let push1' #p #q f u = () (* * Some easier applying, which should prevent frustration @@ -90,22 +80,7 @@ let rec apply_squash_or_lem d t = | _ -> fail "mapply: can't apply (2)" end -class termable (a : Type) = { - to_term : a -> Tac term -} - -instance termable_term : termable term = { - to_term = (fun t -> t); -} - -instance termable_binding : termable binding = { - to_term = (fun b -> binding_to_term b); -} - (* `m` is for `magic` *) +[@@plugin] let mapply0 (t : term) : Tac unit = apply_squash_or_lem 10 t - -let mapply (#ty:Type) {| termable ty |} (x : ty) : Tac unit = - let t = to_term x in - apply_squash_or_lem 10 t diff --git a/ulib/FStar.Tactics.MApply.fsti b/ulib/FStar.Tactics.MApply.fsti new file mode 100644 index 00000000000..ce9e86cdf81 --- /dev/null +++ b/ulib/FStar.Tactics.MApply.fsti @@ -0,0 +1,36 @@ +module FStar.Tactics.MApply + +open FStar.Reflection.V2 +open FStar.Tactics.Effect +open FStar.Tactics.Typeclasses +open FStar.Tactics.V2.SyntaxCoercions + +(* Used by mapply, must be exposed, but not to be used directly *) +private val push1 : (#p:Type) -> (#q:Type) -> + squash (p ==> q) -> + squash p -> + squash q +private val push1' : (#p:Type) -> (#q:Type) -> + (p ==> q) -> + squash p -> + squash q + +class termable (a : Type) = { + to_term : a -> Tac term +} + +instance termable_term : termable term = { + to_term = (fun t -> t); +} + +instance termable_binding : termable binding = { + to_term = (fun b -> binding_to_term b); +} + +(* `m` is for `magic` *) +[@@plugin] +val mapply0 (t : term) : Tac unit + +let mapply (#ty:Type) {| termable ty |} (x : ty) : Tac unit = + let t = to_term x in + mapply0 t From a17581a076b0806f1b5a96334bdc5bd25d1ca52c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 24 Apr 2024 16:01:38 -0700 Subject: [PATCH 089/239] snap --- .../generated/FStar_Tactics_MApply.ml | 220 +++++++++--------- 1 file changed, 115 insertions(+), 105 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_MApply.ml b/ocaml/fstar-lib/generated/FStar_Tactics_MApply.ml index f3c0b78a2aa..155b6a55ce8 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_MApply.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_MApply.ml @@ -1,4 +1,40 @@ open Prims +type 'a termable = + { + to_term: + 'a -> (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr } +let __proj__Mktermable__item__to_term : + 'a . + 'a termable -> + 'a -> + (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr + = fun projectee -> match projectee with | { to_term;_} -> to_term +let to_term : + 'a . + 'a termable -> + 'a -> + (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr + = + fun projectee -> match projectee with | { to_term = to_term1;_} -> to_term1 +let (termable_term : FStar_Tactics_NamedView.term termable) = + { + to_term = + (fun uu___ -> + (fun t -> + Obj.magic (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> t))) + uu___) + } +let (termable_binding : FStar_Tactics_NamedView.binding termable) = + { + to_term = + (fun uu___ -> + (fun b -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> + FStar_Tactics_V2_SyntaxCoercions.binding_to_term b))) + uu___) + } let rec (apply_squash_or_lem : Prims.nat -> FStar_Tactics_NamedView.term -> @@ -17,13 +53,13 @@ let rec (apply_squash_or_lem : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (35)) (Prims.of_int (8)) - (Prims.of_int (35)) (Prims.of_int (43))))) + (Prims.of_int (25)) (Prims.of_int (8)) + (Prims.of_int (25)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (35)) (Prims.of_int (45)) - (Prims.of_int (35)) (Prims.of_int (52))))) + (Prims.of_int (25)) (Prims.of_int (45)) + (Prims.of_int (25)) (Prims.of_int (52))))) (Obj.magic (FStar_Tactics_V2_Derived.apply (FStar_Reflection_V2_Builtins.pack_ln @@ -55,17 +91,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (41)) + (Prims.of_int (31)) (Prims.of_int (13)) - (Prims.of_int (41)) + (Prims.of_int (31)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (41)) + (Prims.of_int (31)) (Prims.of_int (33)) - (Prims.of_int (90)) + (Prims.of_int (80)) (Prims.of_int (41))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -73,17 +109,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (41)) + (Prims.of_int (31)) (Prims.of_int (16)) - (Prims.of_int (41)) + (Prims.of_int (31)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (41)) + (Prims.of_int (31)) (Prims.of_int (13)) - (Prims.of_int (41)) + (Prims.of_int (31)) (Prims.of_int (30))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_env @@ -101,17 +137,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (42)) + (Prims.of_int (32)) (Prims.of_int (17)) - (Prims.of_int (42)) + (Prims.of_int (32)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (41)) + (Prims.of_int (31)) (Prims.of_int (33)) - (Prims.of_int (90)) + (Prims.of_int (80)) (Prims.of_int (41))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_arr @@ -135,18 +171,18 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (46)) + (Prims.of_int (36)) (Prims.of_int (18)) - (Prims.of_int (46)) + (Prims.of_int (36)) (Prims.of_int (32))))) ( FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (46)) + (Prims.of_int (36)) (Prims.of_int (35)) - (Prims.of_int (55)) + (Prims.of_int (45)) (Prims.of_int (41))))) ( FStar_Tactics_Effect.lift_div_tac @@ -170,17 +206,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (47)) + (Prims.of_int (37)) (Prims.of_int (18)) - (Prims.of_int (47)) + (Prims.of_int (37)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (49)) + (Prims.of_int (39)) (Prims.of_int (7)) - (Prims.of_int (55)) + (Prims.of_int (45)) (Prims.of_int (41))))) (Obj.magic (FStar_Tactics_V2_Derived.norm_term @@ -195,17 +231,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (49)) + (Prims.of_int (39)) (Prims.of_int (13)) - (Prims.of_int (49)) + (Prims.of_int (39)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (49)) + (Prims.of_int (39)) (Prims.of_int (7)) - (Prims.of_int (55)) + (Prims.of_int (45)) (Prims.of_int (41))))) (Obj.magic (FStar_Reflection_V2_Formula.term_as_formula' @@ -226,17 +262,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (51)) + (Prims.of_int (41)) (Prims.of_int (11)) - (Prims.of_int (51)) + (Prims.of_int (41)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (52)) + (Prims.of_int (42)) (Prims.of_int (11)) - (Prims.of_int (52)) + (Prims.of_int (42)) (Prims.of_int (38))))) (Obj.magic (FStar_Tactics_V2_Derived.apply_lemma @@ -281,17 +317,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (63)) + (Prims.of_int (53)) (Prims.of_int (18)) - (Prims.of_int (63)) + (Prims.of_int (53)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (65)) + (Prims.of_int (55)) (Prims.of_int (9)) - (Prims.of_int (71)) + (Prims.of_int (61)) (Prims.of_int (43))))) (Obj.magic (FStar_Tactics_V2_Derived.norm_term @@ -306,17 +342,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (65)) + (Prims.of_int (55)) (Prims.of_int (15)) - (Prims.of_int (65)) + (Prims.of_int (55)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (65)) + (Prims.of_int (55)) (Prims.of_int (9)) - (Prims.of_int (71)) + (Prims.of_int (61)) (Prims.of_int (43))))) (Obj.magic (FStar_Reflection_V2_Formula.term_as_formula' @@ -337,17 +373,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (67)) + (Prims.of_int (57)) (Prims.of_int (13)) - (Prims.of_int (67)) + (Prims.of_int (57)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (68)) + (Prims.of_int (58)) (Prims.of_int (13)) - (Prims.of_int (68)) + (Prims.of_int (58)) (Prims.of_int (40))))) (Obj.magic (FStar_Tactics_V2_Derived.apply_lemma @@ -383,17 +419,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (78)) + (Prims.of_int (68)) (Prims.of_int (18)) - (Prims.of_int (78)) + (Prims.of_int (68)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (80)) + (Prims.of_int (70)) (Prims.of_int (9)) - (Prims.of_int (87)) + (Prims.of_int (77)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V2_Derived.norm_term @@ -408,17 +444,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (80)) + (Prims.of_int (70)) (Prims.of_int (15)) - (Prims.of_int (80)) + (Prims.of_int (70)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (80)) + (Prims.of_int (70)) (Prims.of_int (9)) - (Prims.of_int (87)) + (Prims.of_int (77)) (Prims.of_int (20))))) (Obj.magic (FStar_Reflection_V2_Formula.term_as_formula' @@ -438,17 +474,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (82)) + (Prims.of_int (72)) (Prims.of_int (13)) - (Prims.of_int (82)) + (Prims.of_int (72)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (83)) + (Prims.of_int (73)) (Prims.of_int (13)) - (Prims.of_int (83)) + (Prims.of_int (73)) (Prims.of_int (40))))) (Obj.magic (FStar_Tactics_V2_Derived.apply_lemma @@ -477,17 +513,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (86)) + (Prims.of_int (76)) (Prims.of_int (13)) - (Prims.of_int (86)) + (Prims.of_int (76)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (87)) + (Prims.of_int (77)) (Prims.of_int (13)) - (Prims.of_int (87)) + (Prims.of_int (77)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V2_Derived.apply @@ -513,45 +549,21 @@ let rec (apply_squash_or_lem : (FStar_Tactics_V2_Derived.fail "mapply: can't apply (2)")))) uu___4))) uu___4)))) uu___2))) -type 'a termable = - { - to_term: - 'a -> (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr } -let __proj__Mktermable__item__to_term : - 'a . - 'a termable -> - 'a -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr - = fun projectee -> match projectee with | { to_term;_} -> to_term -let to_term : - 'a . - 'a termable -> - 'a -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr - = - fun projectee -> match projectee with | { to_term = to_term1;_} -> to_term1 -let (termable_term : FStar_Tactics_NamedView.term termable) = - { - to_term = - (fun uu___ -> - (fun t -> - Obj.magic (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> t))) - uu___) - } -let (termable_binding : FStar_Tactics_NamedView.binding termable) = - { - to_term = - (fun uu___ -> - (fun b -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - FStar_Tactics_V2_SyntaxCoercions.binding_to_term b))) - uu___) - } let (mapply0 : FStar_Tactics_NamedView.term -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun t -> apply_squash_or_lem (Prims.of_int (10)) t +let _ = + FStar_Tactics_Native.register_tactic "FStar.Tactics.MApply.mapply0" + (Prims.of_int (2)) + (fun psc -> + fun ncb -> + fun us -> + fun args -> + FStar_Tactics_InterpFuns.mk_tactic_interpretation_1 + "FStar.Tactics.MApply.mapply0 (plugin)" + (FStar_Tactics_Native.from_tactic_1 mapply0) + FStar_Reflection_V2_Embeddings.e_term + FStar_Syntax_Embeddings.e_unit psc ncb us args) let mapply : 'ty . 'ty termable -> 'ty -> (unit, unit) FStar_Tactics_Effect.tac_repr = fun uu___ -> @@ -559,14 +571,12 @@ let mapply : FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (110)) (Prims.of_int (10)) - (Prims.of_int (110)) (Prims.of_int (19))))) + (FStar_Range.mk_range "FStar.Tactics.MApply.fsti" + (Prims.of_int (35)) (Prims.of_int (10)) (Prims.of_int (35)) + (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (111)) (Prims.of_int (2)) (Prims.of_int (111)) - (Prims.of_int (26))))) (Obj.magic (to_term uu___ x)) - (fun uu___1 -> - (fun t -> Obj.magic (apply_squash_or_lem (Prims.of_int (10)) t)) - uu___1) \ No newline at end of file + (FStar_Range.mk_range "FStar.Tactics.MApply.fsti" + (Prims.of_int (36)) (Prims.of_int (2)) (Prims.of_int (36)) + (Prims.of_int (11))))) (Obj.magic (to_term uu___ x)) + (fun uu___1 -> (fun t -> Obj.magic (mapply0 t)) uu___1) \ No newline at end of file From 68ad9ab535866747df8f311bd229749a9bd278bb Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Wed, 24 Apr 2024 21:33:18 -0700 Subject: [PATCH 090/239] weaken pretype axiom for non-injective types --- .../generated/FStar_SMTEncoding_Encode.ml | 160 ++++++++++-------- src/smtencoding/FStar.SMTEncoding.Encode.fst | 14 +- 2 files changed, 96 insertions(+), 78 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index 85b8263ece0..d6c777432c3 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -701,79 +701,90 @@ let (prims : prims_t) = | (l', uu___4) -> FStar_Ident.lid_equals l l') prims1 in { mk; is })) let (pretype_axiom : - FStar_Compiler_Range_Type.range -> - FStar_SMTEncoding_Env.env_t -> - FStar_SMTEncoding_Term.term -> - FStar_SMTEncoding_Term.fv Prims.list -> FStar_SMTEncoding_Term.decl) + Prims.bool -> + FStar_Compiler_Range_Type.range -> + FStar_SMTEncoding_Env.env_t -> + FStar_SMTEncoding_Term.term -> + FStar_SMTEncoding_Term.fv Prims.list -> FStar_SMTEncoding_Term.decl) = - fun rng -> - fun env -> - fun tapp -> - fun vars -> - let uu___ = - FStar_SMTEncoding_Env.fresh_fvar - env.FStar_SMTEncoding_Env.current_module_name "x" - FStar_SMTEncoding_Term.Term_sort in - match uu___ with - | (xxsym, xx) -> - let uu___1 = - FStar_SMTEncoding_Env.fresh_fvar - env.FStar_SMTEncoding_Env.current_module_name "f" - FStar_SMTEncoding_Term.Fuel_sort in - (match uu___1 with - | (ffsym, ff) -> - let xx_has_type = - FStar_SMTEncoding_Term.mk_HasTypeFuel ff xx tapp in - let tapp_hash = FStar_SMTEncoding_Term.hash_of_term tapp in - let module_name = - env.FStar_SMTEncoding_Env.current_module_name in - let uu___2 = - let uu___3 = + fun term_constr_eq -> + fun rng -> + fun env -> + fun tapp -> + fun vars -> + let uu___ = + FStar_SMTEncoding_Env.fresh_fvar + env.FStar_SMTEncoding_Env.current_module_name "x" + FStar_SMTEncoding_Term.Term_sort in + match uu___ with + | (xxsym, xx) -> + let uu___1 = + FStar_SMTEncoding_Env.fresh_fvar + env.FStar_SMTEncoding_Env.current_module_name "f" + FStar_SMTEncoding_Term.Fuel_sort in + (match uu___1 with + | (ffsym, ff) -> + let xx_has_type = + FStar_SMTEncoding_Term.mk_HasTypeFuel ff xx tapp in + let tapp_hash = FStar_SMTEncoding_Term.hash_of_term tapp in + let module_name = + env.FStar_SMTEncoding_Env.current_module_name in + let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = + let uu___6 = + FStar_SMTEncoding_Term.mk_fv + (xxsym, FStar_SMTEncoding_Term.Term_sort) in + let uu___7 = + let uu___8 = + FStar_SMTEncoding_Term.mk_fv + (ffsym, FStar_SMTEncoding_Term.Fuel_sort) in + uu___8 :: vars in + uu___6 :: uu___7 in + let uu___6 = + let uu___7 = + let uu___8 = + if term_constr_eq + then + let uu___9 = + let uu___10 = + FStar_SMTEncoding_Util.mkApp + ("Term_constr_id", [tapp]) in + let uu___11 = + let uu___12 = + let uu___13 = + let uu___14 = + FStar_SMTEncoding_Util.mkApp + ("PreType", [xx]) in + [uu___14] in + ("Term_constr_id", uu___13) in + FStar_SMTEncoding_Util.mkApp uu___12 in + (uu___10, uu___11) in + FStar_SMTEncoding_Util.mkEq uu___9 + else + (let uu___10 = + let uu___11 = + FStar_SMTEncoding_Util.mkApp + ("PreType", [xx]) in + (tapp, uu___11) in + FStar_SMTEncoding_Util.mkEq uu___10) in + (xx_has_type, uu___8) in + FStar_SMTEncoding_Util.mkImp uu___7 in + ([[xx_has_type]], uu___5, uu___6) in + FStar_SMTEncoding_Term.mkForall rng uu___4 in let uu___4 = let uu___5 = let uu___6 = - FStar_SMTEncoding_Term.mk_fv - (xxsym, FStar_SMTEncoding_Term.Term_sort) in - let uu___7 = - let uu___8 = - FStar_SMTEncoding_Term.mk_fv - (ffsym, FStar_SMTEncoding_Term.Fuel_sort) in - uu___8 :: vars in - uu___6 :: uu___7 in - let uu___6 = - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = - FStar_SMTEncoding_Util.mkApp - ("Term_constr_id", [tapp]) in - let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = - FStar_SMTEncoding_Util.mkApp - ("PreType", [xx]) in - [uu___14] in - ("Term_constr_id", uu___13) in - FStar_SMTEncoding_Util.mkApp uu___12 in - (uu___10, uu___11) in - FStar_SMTEncoding_Util.mkEq uu___9 in - (xx_has_type, uu___8) in - FStar_SMTEncoding_Util.mkImp uu___7 in - ([[xx_has_type]], uu___5, uu___6) in - FStar_SMTEncoding_Term.mkForall rng uu___4 in - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = - FStar_Compiler_Util.digest_of_string tapp_hash in - Prims.strcat "_pretyping_" uu___7 in - Prims.strcat module_name uu___6 in - FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.mk_unique - uu___5 in - (uu___3, (FStar_Pervasives_Native.Some "pretyping"), - uu___4) in - FStar_SMTEncoding_Util.mkAssume uu___2) + let uu___7 = + FStar_Compiler_Util.digest_of_string tapp_hash in + Prims.strcat "_pretyping_" uu___7 in + Prims.strcat module_name uu___6 in + FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.mk_unique + uu___5 in + (uu___3, (FStar_Pervasives_Native.Some "pretyping"), + uu___4) in + FStar_SMTEncoding_Util.mkAssume uu___2) let (primitive_type_axioms : FStar_TypeChecker_Env.env -> FStar_Ident.lident -> @@ -2109,8 +2120,9 @@ let (encode_free_var : FStar_Syntax_Syntax.range_of_fv fv in pretype_axiom - uu___15 env2 - vapp vars1 in + false uu___15 + env2 vapp + vars1 in [uu___14] in uu___12 :: uu___13 else [] in @@ -4427,8 +4439,10 @@ let (encode_sig_inductive : let uu___12 = let uu___13 = FStar_Ident.range_of_lid t in - pretype_axiom uu___13 env2 tapp - vars in + pretype_axiom + (Prims.op_Negation + is_injective_on_params) + uu___13 env2 tapp vars in [uu___12] in FStar_SMTEncoding_Term.mk_decls_trivial uu___11 in diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index 7ce6a13c8b2..b2f58d850f7 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -168,15 +168,19 @@ let prims = {mk=mk; is=is} -let pretype_axiom rng env tapp vars = +let pretype_axiom term_constr_eq rng env tapp vars = let xxsym, xx = fresh_fvar env.current_module_name "x" Term_sort in let ffsym, ff = fresh_fvar env.current_module_name "f" Fuel_sort in let xx_has_type = mk_HasTypeFuel ff xx tapp in let tapp_hash = Term.hash_of_term tapp in let module_name = env.current_module_name in Util.mkAssume(mkForall rng ([[xx_has_type]], mk_fv (xxsym, Term_sort)::mk_fv (ffsym, Fuel_sort)::vars, - mkImp(xx_has_type, mkEq(mkApp ("Term_constr_id", [tapp]), - mkApp ("Term_constr_id", [mkApp("PreType", [xx])])))), + mkImp(xx_has_type, + (if term_constr_eq + then mkEq(mkApp ("Term_constr_id", [tapp]), + mkApp ("Term_constr_id", [mkApp("PreType", [xx])])) + else mkEq(tapp, + mkApp("PreType", [xx]))))), Some "pretyping", (varops.mk_unique (module_name ^ "_pretyping_" ^ (BU.digest_of_string tapp_hash)))) @@ -534,7 +538,7 @@ let encode_free_var uninterpreted env fv tt t_norm quals :decls_t * env_t = let freshness = if quals |> List.contains New then [Term.fresh_constructor (S.range_of_fv fv) (vname, vars |> List.map fv_sort, Term_sort, varops.next_id()); - pretype_axiom (S.range_of_fv fv) env vapp vars] + pretype_axiom false (S.range_of_fv fv) env vapp vars] else [] in let g = decls1@decls2@decls3@(freshness@typingAx::mk_disc_proj_axioms guard encoded_res_t vapp vars |> mk_decls_trivial) in @@ -1211,7 +1215,7 @@ let encode_sig_inductive (is_injective_on_params:bool) (env:env_t) (se:sigelt) let aux = kindingAx @(inversion_axioms env tapp vars) - @([pretype_axiom (Ident.range_of_lid t) env tapp vars] |> mk_decls_trivial) + @([pretype_axiom (not is_injective_on_params) (Ident.range_of_lid t) env tapp vars] |> mk_decls_trivial) in (decls |> mk_decls_trivial)@binder_decls@aux, env From 9979879cc7a78adfe620ddcf6f075637038b0300 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Wed, 24 Apr 2024 21:33:29 -0700 Subject: [PATCH 091/239] Revert "temporary admits" This reverts commit 600963d0d191cbfcab87a62d36dd24e2a0770a49. --- ulib/LowStar.Monotonic.Buffer.fst | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/ulib/LowStar.Monotonic.Buffer.fst b/ulib/LowStar.Monotonic.Buffer.fst index 97d428f670f..9e270442c43 100644 --- a/ulib/LowStar.Monotonic.Buffer.fst +++ b/ulib/LowStar.Monotonic.Buffer.fst @@ -233,7 +233,7 @@ let live_same_addresses_equal_types_and_preorders' = Heap.lemma_distinct_addrs_distinct_preorders (); Heap.lemma_distinct_addrs_distinct_mm (); let s1 : Seq.seq a1 = as_seq h b1 in - assume (Seq.seq a1 == Seq.seq a2); + assert (Seq.seq a1 == Seq.seq a2); let s1' : Seq.seq a2 = coerce_eq _ s1 in assert (s1 === s1'); lemma_equal_instances_implies_equal_types a1 a2 s1 s1' @@ -1141,7 +1141,7 @@ let modifies_loc_buffer_from_to_intro' #a #rrel #rel b from to l h h' = // prove that the types, rrels, rels are equal Heap.lemma_distinct_addrs_distinct_preorders (); Heap.lemma_distinct_addrs_distinct_mm (); - assume (Seq.seq t' == Seq.seq a); + assert (Seq.seq t' == Seq.seq a); let _s0 : Seq.seq a = as_seq h b in let _s1 : Seq.seq t' = coerce_eq _ _s0 in lemma_equal_instances_implies_equal_types a t' _s0 _s1; @@ -1332,7 +1332,6 @@ let g_upd_seq_as_seq #a #_ #_ b s h = // prove modifies_1_preserves_ubuffers Heap.lemma_distinct_addrs_distinct_preorders (); Heap.lemma_distinct_addrs_distinct_mm (); - admit(); s_lemma_equal_instances_implies_equal_types (); modifies_1_modifies b h h' end @@ -1343,7 +1342,6 @@ let g_upd_modifies_strong #_ #_ #_ b i v h = Heap.lemma_distinct_addrs_distinct_preorders (); Heap.lemma_distinct_addrs_distinct_mm (); s_lemma_equal_instances_implies_equal_types (); - admit(); modifies_1_from_to_modifies b (U32.uint_to_t i) (U32.uint_to_t (i + 1)) h h' #pop-options From 331f0b9e65d5c99dae60dddcfc15c6cd8539bcd7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 25 Apr 2024 13:37:12 -0700 Subject: [PATCH 092/239] Add a test --- tests/micro-benchmarks/DeltaDepthUnif.fst | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) create mode 100644 tests/micro-benchmarks/DeltaDepthUnif.fst diff --git a/tests/micro-benchmarks/DeltaDepthUnif.fst b/tests/micro-benchmarks/DeltaDepthUnif.fst new file mode 100644 index 00000000000..6d1f49474f3 --- /dev/null +++ b/tests/micro-benchmarks/DeltaDepthUnif.fst @@ -0,0 +1,23 @@ +module DeltaDepthUnif + +(* Misc tests about unification, unfolding, etc *) + +open FStar.Reflection.V2 +open FStar.Reflection.Typing + +assume val tyc : term -> Type0 + +let test (x : tyc bool_ty) + : tyc (binder_sort (mk_binder (Sealed.seal "x") bool_ty Q_Explicit)) + = x + +open FStar.Squash + +assume val p : Type0 + +val test1 : (~p) +let test1 = return_squash (magic ()) + +assume val f : p -> False +val test2 : (~p) +let test2 = return_squash f From bf7da7825cfbea9cdb7c6ea8d58d3031670ecd19 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 25 Apr 2024 13:36:40 -0700 Subject: [PATCH 093/239] ToSyntax: remove dead code --- src/tosyntax/FStar.ToSyntax.ToSyntax.fst | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst index a2809bf79d9..430f8b73215 100644 --- a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst +++ b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst @@ -564,24 +564,6 @@ let mk_lb (attrs, n, t, e, pos) = { } let no_annot_abs bs t = U.abs bs t None -let mk_ref_read tm = - let tm' = Tm_app ({ - hd=S.fv_to_tm (S.lid_and_dd_as_fv C.sread_lid delta_constant None); - args=[ tm, S.as_aqual_implicit false ]}) in - S.mk tm' tm.pos - -let mk_ref_alloc tm = - let tm' = Tm_app ({ - hd=S.fv_to_tm (S.lid_and_dd_as_fv C.salloc_lid delta_constant None); - args=[ tm, S.as_aqual_implicit false ]}) in - S.mk tm' tm.pos - -let mk_ref_assign t1 t2 pos = - let tm = Tm_app ({ - hd=S.fv_to_tm (S.lid_and_dd_as_fv C.swrite_lid delta_constant None); - args=[ t1, S.as_aqual_implicit false; t2, S.as_aqual_implicit false ]}) in - S.mk tm pos - (* * Collect the explicitly annotated universes in the sigelt, close the sigelt with them, and stash them appropriately in the sigelt *) From 572b573d181f5cae6b189f1387d71d28c18bf8bf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 24 Apr 2024 20:40:04 -0700 Subject: [PATCH 094/239] Format some comments --- src/syntax/FStar.Syntax.Syntax.fsti | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/src/syntax/FStar.Syntax.Syntax.fsti b/src/syntax/FStar.Syntax.Syntax.fsti index 0368a976caa..96c47947b17 100644 --- a/src/syntax/FStar.Syntax.Syntax.fsti +++ b/src/syntax/FStar.Syntax.Syntax.fsti @@ -107,10 +107,16 @@ type maybe_set_use_range = [@@ PpxDerivingYoJson; PpxDerivingShow ] type delta_depth = - | Delta_constant_at_level of int //A symbol that can be unfolded n types to a term whose head is a constant, e.g., nat is (Delta_unfoldable 1) to int, level 0 is a constant - | Delta_equational_at_level of int //level 0 is a symbol that may be equated to another by extensional reasoning, n > 0 can be unfolded n times to a Delta_equational_at_level 0 term - | Delta_abstract of delta_depth //A symbol marked abstract whose depth is the argument d - + | Delta_constant_at_level of int + // ^ A symbol that can be unfolded n times to a term whose head is a + // constant, e.g., nat is (Delta_constant_at_level 1) to int, level 0 + // is a literal constant. + | Delta_equational_at_level of int + // ^ Level 0 is a symbol that may be equated to another by + // extensional reasoning, n > 0 can be unfolded n times to a + // Delta_equational_at_level 0 term. + | Delta_abstract of delta_depth + // ^ A symbol marked abstract whose depth is the argument d. [@@ PpxDerivingYoJson; PpxDerivingShow ] type should_check_uvar = From 12e730267e4cedfa1bf92c88e2de4be9608f28a9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 25 Apr 2024 09:18:55 -0700 Subject: [PATCH 095/239] Removing query_stats from some tests and examples --- examples/dsls/bool_refinement/BoolRefinement.fst | 8 ++++---- .../DependentBoolRefinement.fst | 10 +++++----- .../everparse/tls/Negotiation.Writers.NoHoare.fst | 2 +- tests/bug-reports/Bug2496.fst | 2 +- 4 files changed, 11 insertions(+), 11 deletions(-) diff --git a/examples/dsls/bool_refinement/BoolRefinement.fst b/examples/dsls/bool_refinement/BoolRefinement.fst index 770f7f7bd4f..8edbb0546f6 100755 --- a/examples/dsls/bool_refinement/BoolRefinement.fst +++ b/examples/dsls/bool_refinement/BoolRefinement.fst @@ -516,7 +516,7 @@ let weaken (f:RT.fstar_top_env) (sg:src_env) (hyp:var { None? (lookup sg hyp) } let exp (sg:src_env) = e:src_exp { ln e /\ (forall x. x `Set.mem` freevars e ==> Some? (lookup sg x)) } -#push-options "--fuel 2 --ifuel 2 --z3rlimit_factor 6 --query_stats" +#push-options "--fuel 2 --ifuel 2 --z3rlimit_factor 6" let rec check (f:RT.fstar_top_env) (sg:src_env) (e:exp sg) @@ -650,7 +650,7 @@ let src_refinements_are_closed (e:src_exp {ln e && closed e}) src_refinements_are_closed_core 0 e elt -#push-options "--query_stats --fuel 8 --ifuel 2 --z3rlimit_factor 2" +#push-options "--fuel 8 --ifuel 2 --z3rlimit_factor 2" let rec elab_open_commute' (n:nat) (e:src_exp { ln' e n }) (x:var) : Lemma (ensures RT.subst_term (elab_exp e) (RT.open_with_var x n) == @@ -949,7 +949,7 @@ let rec as_bindings_rename_env_append (sg sg':src_env) (x y:var) let rt_rename (x y:var) : RT.subst_elt = RT.NT x (RT.var_as_term y) -#push-options "--query_stats --fuel 8 --ifuel 4 --z3rlimit_factor 10" +#push-options "--fuel 8 --ifuel 4 --z3rlimit_factor 10" let rec rename_elab_commute_core (m:int) (e:src_exp { ln' e m } ) (x y:var) (n:nat) : Lemma (ensures RT.subst_term (elab_exp e) (RT.shift_subst_n n [rt_rename x y]) == @@ -1123,7 +1123,7 @@ let sub_typing_renaming (#f:RT.fstar_top_env) | S_ELab g _ _ d -> S_ELab _ _ _ (core_subtyping_renaming sg sg' x y b t0 t1 d) -#push-options "--query_stats --fuel 2 --ifuel 2 --z3rlimit_factor 2" +#push-options "--fuel 2 --ifuel 2 --z3rlimit_factor 2" let freevars_included_in (e:src_exp) (sg:src_env) = forall x. x `Set.mem` freevars e ==> Some? (lookup sg x) diff --git a/examples/dsls/dependent_bool_refinement/DependentBoolRefinement.fst b/examples/dsls/dependent_bool_refinement/DependentBoolRefinement.fst index 8c3c0cf1b20..2eb14f17226 100755 --- a/examples/dsls/dependent_bool_refinement/DependentBoolRefinement.fst +++ b/examples/dsls/dependent_bool_refinement/DependentBoolRefinement.fst @@ -105,7 +105,7 @@ let open_ty t v = open_ty' t (EVar v) 0 let close_ty t v = close_ty' t v 0 let open_ty_with t e = open_ty' t e 0 -#push-options "--query_stats --fuel 4 --ifuel 2 --z3rlimit_factor 8" +#push-options "--fuel 4 --ifuel 2 --z3rlimit_factor 8" let rec open_exp_freevars (e:src_exp) (v:src_exp) (n:nat) : Lemma (ensures (freevars e `Set.subset` freevars (open_exp' e v n)) /\ @@ -472,7 +472,7 @@ and check_ok (e:src_exp) (sg:src_env) | EApp e1 e2 -> check_ok e1 sg && check_ok e2 sg -#push-options "--fuel 2 --ifuel 2 --z3rlimit_factor 6 --query_stats" +#push-options "--fuel 2 --ifuel 2 --z3rlimit_factor 6" let rec check (f:fstar_top_env) (sg:src_env) @@ -578,7 +578,7 @@ let rec extend_env_l_lookup_bvar (g:R.env) (sg:src_env) (x:var) | [] -> () | hd :: tl -> extend_env_l_lookup_bvar g tl x -#push-options "--query_stats --fuel 8 --ifuel 2 --z3rlimit_factor 2" +#push-options "--fuel 8 --ifuel 2 --z3rlimit_factor 2" let rec elab_open_commute' (n:nat) (e:src_exp) (x:src_exp) : Lemma (ensures RT.subst_term (elab_exp e) [ RT.DT n (elab_exp x) ] == @@ -638,7 +638,7 @@ let rec extend_env_l_lookup_fvar (g:R.env) (sg:src_env) (fv:R.fv) | [] -> () | hd::tl -> extend_env_l_lookup_fvar g tl fv -#push-options "--query_stats --fuel 2 --ifuel 2 --z3rlimit_factor 2" +#push-options "--fuel 2 --ifuel 2 --z3rlimit_factor 2" let subtyping_soundness #f (#sg:src_env) (#t0 #t1:src_ty) (ds:sub_typing f sg t0 t1) : GTot (RT.sub_typing (extend_env_l f sg) (elab_ty t0) (elab_ty t1)) @@ -646,7 +646,7 @@ let subtyping_soundness #f (#sg:src_env) (#t0 #t1:src_ty) (ds:sub_typing f sg t0 | S_Refl _ _ -> RT.Rel_equiv _ _ _ _ (RT.Rel_refl _ _ _) | S_ELab _ _ _ d -> d -#push-options "--query_stats --fuel 8 --ifuel 2 --z3rlimit_factor 4" +#push-options "--fuel 8 --ifuel 2 --z3rlimit_factor 4" let rec elab_close_commute' (n:nat) (e:src_exp) (x:var) : Lemma (ensures RT.subst_term (elab_exp e) [ RT.ND x n ] == diff --git a/examples/layeredeffects/everparse/tls/Negotiation.Writers.NoHoare.fst b/examples/layeredeffects/everparse/tls/Negotiation.Writers.NoHoare.fst index dc08de21681..8698385a864 100644 --- a/examples/layeredeffects/everparse/tls/Negotiation.Writers.NoHoare.fst +++ b/examples/layeredeffects/everparse/tls/Negotiation.Writers.NoHoare.fst @@ -14,7 +14,7 @@ open Negotiation module U32 = FStar.UInt32 module B = LowStar.Buffer -#push-options "--z3rlimit 16 --query_stats" +#push-options "--z3rlimit 16" inline_for_extraction noextract diff --git a/tests/bug-reports/Bug2496.fst b/tests/bug-reports/Bug2496.fst index 07894eb874f..cb7fccefe08 100755 --- a/tests/bug-reports/Bug2496.fst +++ b/tests/bug-reports/Bug2496.fst @@ -34,7 +34,7 @@ let singleton_includes_argument_lemma () : Lemma (forall (ty: eqtype) (r: ty). includes (singleton r) r) = () -#push-options "--z3cliopt 'smt.qi.eager_threshold=100' --query_stats --fuel 1 --ifuel 1" +#push-options "--z3cliopt 'smt.qi.eager_threshold=100' --fuel 1 --ifuel 1" #restart-solver let singleton_includes_argument_lemma_bad () : Lemma (forall (ty: eqtype) (r: ty). includes (singleton r) r) From 733597fe393729d6a36267ecb0cf8d8f41d2b9bc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 24 Apr 2024 18:08:03 -0700 Subject: [PATCH 096/239] Normalize: respect --ugly in N.term_to_doc --- src/typechecker/FStar.TypeChecker.Normalize.fst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/typechecker/FStar.TypeChecker.Normalize.fst b/src/typechecker/FStar.TypeChecker.Normalize.fst index 9986861e353..041692cef57 100644 --- a/src/typechecker/FStar.TypeChecker.Normalize.fst +++ b/src/typechecker/FStar.TypeChecker.Normalize.fst @@ -3184,7 +3184,7 @@ let term_to_doc env t = try normalize [AllowUnboundUniverses] env t with e -> Errors.log_issue t.pos (Errors.Warning_NormalizationFailure, (BU.format1 "Normalization failed with error %s\n" (BU.message_of_exn e))) ; t in - FStar.Syntax.Print.Pretty.term_to_doc' (DsEnv.set_current_module env.dsenv env.curmodule) t + FStar.Syntax.Print.term_to_doc' (DsEnv.set_current_module env.dsenv env.curmodule) t let term_to_string env t = GenSym.with_frozen_gensym (fun () -> let t = From 700949517a4837d1416b0995bf335f14d8e2e106 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 25 Apr 2024 15:24:33 -0700 Subject: [PATCH 097/239] nit, more use of show --- src/typechecker/FStar.TypeChecker.Rel.fst | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.Rel.fst b/src/typechecker/FStar.TypeChecker.Rel.fst index a95b34d944d..398766f82a2 100644 --- a/src/typechecker/FStar.TypeChecker.Rel.fst +++ b/src/typechecker/FStar.TypeChecker.Rel.fst @@ -4228,14 +4228,14 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = let _ = if debug wl (Options.Other "Rel") then BU.print ">> (%s) (smtok=%s)\n>>> head1 = %s [interpreted=%s; no_free_uvars=%s]\n>>> head2 = %s [interpreted=%s; no_free_uvars=%s]\n" - [(string_of_int problem.pid); - (string_of_bool wl.smt_ok); + [(show problem.pid); + (show wl.smt_ok); (show head1); - (string_of_bool (Env.is_interpreted wl.tcenv head1)); - (string_of_bool (no_free_uvars t1)); + (show (Env.is_interpreted wl.tcenv head1)); + (show (no_free_uvars t1)); (show head2); - (string_of_bool (Env.is_interpreted wl.tcenv head2)); - (string_of_bool (no_free_uvars t2))] + (show (Env.is_interpreted wl.tcenv head2)); + (show (no_free_uvars t2))] in let equal t1 t2 : bool = (* Try comparing the terms as they are. If we get Equal or NotEqual, From 8daf81bbd7e706aadf43ba4f94c8a457e9e4c95c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 25 Apr 2024 15:41:01 -0700 Subject: [PATCH 098/239] snap --- .../generated/FStar_ToSyntax_ToSyntax.ml | 77 ----- .../generated/FStar_TypeChecker_Normalize.ml | 2 +- .../generated/FStar_TypeChecker_Rel.ml | 324 ++++++++++++++---- 3 files changed, 253 insertions(+), 150 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml index 710914b9822..3abc54bb2a7 100644 --- a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml +++ b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml @@ -1021,83 +1021,6 @@ let (no_annot_abs : FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax) = fun bs -> fun t -> FStar_Syntax_Util.abs bs t FStar_Pervasives_Native.None -let (mk_ref_read : - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax) - = - fun tm -> - let tm' = - let uu___ = - let uu___1 = - let uu___2 = - FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.sread_lid - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in - FStar_Syntax_Syntax.fv_to_tm uu___2 in - let uu___2 = - let uu___3 = - let uu___4 = FStar_Syntax_Syntax.as_aqual_implicit false in - (tm, uu___4) in - [uu___3] in - { FStar_Syntax_Syntax.hd = uu___1; FStar_Syntax_Syntax.args = uu___2 - } in - FStar_Syntax_Syntax.Tm_app uu___ in - FStar_Syntax_Syntax.mk tm' tm.FStar_Syntax_Syntax.pos -let (mk_ref_alloc : - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax) - = - fun tm -> - let tm' = - let uu___ = - let uu___1 = - let uu___2 = - FStar_Syntax_Syntax.lid_and_dd_as_fv - FStar_Parser_Const.salloc_lid - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in - FStar_Syntax_Syntax.fv_to_tm uu___2 in - let uu___2 = - let uu___3 = - let uu___4 = FStar_Syntax_Syntax.as_aqual_implicit false in - (tm, uu___4) in - [uu___3] in - { FStar_Syntax_Syntax.hd = uu___1; FStar_Syntax_Syntax.args = uu___2 - } in - FStar_Syntax_Syntax.Tm_app uu___ in - FStar_Syntax_Syntax.mk tm' tm.FStar_Syntax_Syntax.pos -let (mk_ref_assign : - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> - FStar_Compiler_Range_Type.range -> - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax) - = - fun t1 -> - fun t2 -> - fun pos -> - let tm = - let uu___ = - let uu___1 = - let uu___2 = - FStar_Syntax_Syntax.lid_and_dd_as_fv - FStar_Parser_Const.swrite_lid - FStar_Syntax_Syntax.delta_constant - FStar_Pervasives_Native.None in - FStar_Syntax_Syntax.fv_to_tm uu___2 in - let uu___2 = - let uu___3 = - let uu___4 = FStar_Syntax_Syntax.as_aqual_implicit false in - (t1, uu___4) in - let uu___4 = - let uu___5 = - let uu___6 = FStar_Syntax_Syntax.as_aqual_implicit false in - (t2, uu___6) in - [uu___5] in - uu___3 :: uu___4 in - { - FStar_Syntax_Syntax.hd = uu___1; - FStar_Syntax_Syntax.args = uu___2 - } in - FStar_Syntax_Syntax.Tm_app uu___ in - FStar_Syntax_Syntax.mk tm pos let rec (generalize_annotated_univs : FStar_Syntax_Syntax.sigelt -> FStar_Syntax_Syntax.sigelt) = fun s -> diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml index 04bc95afc05..2524b72fdc7 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml @@ -8445,7 +8445,7 @@ let (term_to_doc : FStar_Syntax_DsEnv.set_current_module env1.FStar_TypeChecker_Env.dsenv env1.FStar_TypeChecker_Env.curmodule in - FStar_Syntax_Print_Pretty.term_to_doc' uu___ t1 + FStar_Syntax_Print.term_to_doc' uu___ t1 let (term_to_string : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> Prims.string) = fun env1 -> diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml index 075f1913578..8270d792235 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml @@ -10608,11 +10608,16 @@ and (solve_t' : tprob -> worklist -> solution) = then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -10622,11 +10627,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -10636,12 +10647,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -10744,11 +10759,16 @@ and (solve_t' : tprob -> worklist -> solution) = then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -10758,11 +10778,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -10772,12 +10798,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -10880,11 +10910,16 @@ and (solve_t' : tprob -> worklist -> solution) = then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -10894,11 +10929,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -10908,12 +10949,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -11016,11 +11061,16 @@ and (solve_t' : tprob -> worklist -> solution) = then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -11030,11 +11080,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -11044,12 +11100,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -11152,11 +11212,16 @@ and (solve_t' : tprob -> worklist -> solution) = then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -11166,11 +11231,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -11180,12 +11251,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -11288,11 +11363,16 @@ and (solve_t' : tprob -> worklist -> solution) = then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -11302,11 +11382,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -11316,12 +11402,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -11424,11 +11514,16 @@ and (solve_t' : tprob -> worklist -> solution) = then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -11438,11 +11533,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -11452,12 +11553,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -11560,11 +11665,16 @@ and (solve_t' : tprob -> worklist -> solution) = then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -11574,11 +11684,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -11588,12 +11704,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -11696,11 +11816,16 @@ and (solve_t' : tprob -> worklist -> solution) = then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -11710,11 +11835,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -11724,12 +11855,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -11832,11 +11967,16 @@ and (solve_t' : tprob -> worklist -> solution) = then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -11846,11 +11986,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -11860,12 +12006,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -11968,11 +12118,16 @@ and (solve_t' : tprob -> worklist -> solution) = then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -11982,11 +12137,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -11996,12 +12157,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -12104,11 +12269,16 @@ and (solve_t' : tprob -> worklist -> solution) = then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -12118,11 +12288,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -12132,12 +12308,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in From 2828782b99624abc31fff34fd5b93bc0bd496d0a Mon Sep 17 00:00:00 2001 From: Aseem Rastogi Date: Fri, 26 Apr 2024 04:44:38 +0000 Subject: [PATCH 099/239] when interleaving, get names of syntax extension decls, requires changing the signature of extension parsers to expose a parse_decl_name function --- src/parser/FStar.Parser.AST.Util.fsti | 19 +++++++++++++------ src/tosyntax/FStar.ToSyntax.Interleave.fst | 19 +++++++++++++++++++ 2 files changed, 32 insertions(+), 6 deletions(-) diff --git a/src/parser/FStar.Parser.AST.Util.fsti b/src/parser/FStar.Parser.AST.Util.fsti index 83e6a629dec..c63877238b0 100644 --- a/src/parser/FStar.Parser.AST.Util.fsti +++ b/src/parser/FStar.Parser.AST.Util.fsti @@ -37,11 +37,18 @@ type error_message = { range: FStar.Compiler.Range.range; } -type extension_parser = - open_namespaces_and_abbreviations -> - contents:string -> - p:FStar.Compiler.Range.range -> - either error_message decl +type extension_parser = { + parse_decl_name: + (contents:string -> + FStar.Compiler.Range.range -> + either error_message FStar.Ident.ident); + + parse_decl: + (open_namespaces_and_abbreviations -> + contents:string -> + p:FStar.Compiler.Range.range -> + either error_message decl) +} val register_extension_parser (extension_name:string) (parser:extension_parser) : unit -val lookup_extension_parser (extension_name:string) : option extension_parser \ No newline at end of file +val lookup_extension_parser (extension_name:string) : option extension_parser diff --git a/src/tosyntax/FStar.ToSyntax.Interleave.fst b/src/tosyntax/FStar.ToSyntax.Interleave.fst index 79ce8f8b230..9108ae88b56 100644 --- a/src/tosyntax/FStar.ToSyntax.Interleave.fst +++ b/src/tosyntax/FStar.ToSyntax.Interleave.fst @@ -26,6 +26,8 @@ open FStar.Errors open FStar.Syntax.Syntax open FStar.Parser.AST +module BU = FStar.Compiler.Util + (* Some basic utilities *) let id_eq_lid i (l:lident) = (string_of_id i) = (string_of_id (ident_of_lid l)) @@ -52,6 +54,23 @@ let definition_lids d = [Ident.lid_of_ids [id]] | _ -> []) | Splice (_, ids, _) -> List.map (fun id -> Ident.lid_of_ids [id]) ids + | DeclSyntaxExtension (extension_name, code, _, range) -> begin + let ext_parser = FStar.Parser.AST.Util.lookup_extension_parser extension_name in + match ext_parser with + | None -> + raise_error + (Errors.Fatal_SyntaxError, + BU.format1 "Unknown syntax extension %s" extension_name) + d.drange + | Some parser -> + match parser.parse_decl_name code range with + | Inl error -> + raise_error + (Errors.Fatal_SyntaxError, error.message) + error.range + | Inr id -> + [Ident.lid_of_ids [id]] + end | _ -> [] let is_definition_of x d = From 2ac67f76de7ae728bf76852961df3d420654158d Mon Sep 17 00:00:00 2001 From: Aseem Rastogi Date: Fri, 26 Apr 2024 04:45:31 +0000 Subject: [PATCH 100/239] fixes for changes in the signature of extension parser --- src/tosyntax/FStar.ToSyntax.ToSyntax.fst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst index a2809bf79d9..af4f1d19f79 100644 --- a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst +++ b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst @@ -4231,7 +4231,7 @@ and desugar_decl_core env (d_attrs:list S.term) (d:decl) : (env_t * sigelts) = open_namespaces = open_modules_and_namespaces env; module_abbreviations = module_abbrevs env } in - match parser opens code range with + match parser.parse_decl opens code range with | Inl error -> raise_error (Errors.Fatal_SyntaxError, error.message) From ea0c07e9d7b5f2dce96a75a0c1e7afa086fdf999 Mon Sep 17 00:00:00 2001 From: Aseem Rastogi Date: Fri, 26 Apr 2024 04:47:02 +0000 Subject: [PATCH 101/239] support for passing an expected type to the dsl checker --- ulib/FStar.Stubs.Reflection.V2.Builtins.fsti | 7 +++ ulib/experimental/FStar.Reflection.Typing.fst | 5 ++ .../experimental/FStar.Reflection.Typing.fsti | 63 +++++++++++++++---- 3 files changed, 63 insertions(+), 12 deletions(-) diff --git a/ulib/FStar.Stubs.Reflection.V2.Builtins.fsti b/ulib/FStar.Stubs.Reflection.V2.Builtins.fsti index 5cb16c3537c..de9ced3b1f6 100644 --- a/ulib/FStar.Stubs.Reflection.V2.Builtins.fsti +++ b/ulib/FStar.Stubs.Reflection.V2.Builtins.fsti @@ -101,6 +101,13 @@ val inspect_pack_universe (uv:universe_view) : Lemma (inspect_universe (pack_uni val pack_inspect_ident (u:ident) : Lemma (pack_ident (inspect_ident u) == u) val inspect_pack_ident (uv:ident_view) : Lemma (inspect_ident (pack_ident uv) == uv) +val pack_inspect_lb (lb:letbinding) : Lemma (pack_lb (inspect_lb lb) == lb) +val inspect_pack_lb (lbv:lb_view) : Lemma (inspect_lb (pack_lb lbv) == lbv) + +val pack_inspect_sigelt (se:sigelt) : Lemma ((~(Unk? (inspect_sigelt se))) ==> pack_sigelt (inspect_sigelt se) == se) +val inspect_pack_sigelt (sev:sigelt_view { ~ (Unk? sev) }) : Lemma (inspect_sigelt (pack_sigelt sev) == sev) + + val simple_binder_defn (b:binder) : Lemma (binder_is_simple b <==> Q_Explicit? (inspect_binder b).qual /\ Nil? (inspect_binder b).attrs) diff --git a/ulib/experimental/FStar.Reflection.Typing.fst b/ulib/experimental/FStar.Reflection.Typing.fst index 84788a5250a..99ffe08fe41 100644 --- a/ulib/experimental/FStar.Reflection.Typing.fst +++ b/ulib/experimental/FStar.Reflection.Typing.fst @@ -53,6 +53,11 @@ let pack_inspect_fv = R.pack_inspect_fv let inspect_pack_universe = R.inspect_pack_universe let pack_inspect_universe = R.pack_inspect_universe +let inspect_pack_lb = R.inspect_pack_lb +let pack_inspect_lb = R.pack_inspect_lb + +let inspect_pack_sigelt = R.inspect_pack_sigelt +let pack_inspect_sigelt = R.pack_inspect_sigelt let lookup_bvar (e:env) (x:int) : option term = magic () diff --git a/ulib/experimental/FStar.Reflection.Typing.fsti b/ulib/experimental/FStar.Reflection.Typing.fsti index 7f6a9a50321..2b2be79255d 100644 --- a/ulib/experimental/FStar.Reflection.Typing.fsti +++ b/ulib/experimental/FStar.Reflection.Typing.fsti @@ -119,6 +119,23 @@ val pack_inspect_universe (u:R.universe) (ensures R.pack_universe (R.inspect_universe u) == u) [SMTPat (R.pack_universe (R.inspect_universe u))] +val inspect_pack_lb (lb:R.lb_view) + : Lemma (ensures R.inspect_lb (R.pack_lb lb) == lb) + [SMTPat (R.inspect_lb (R.pack_lb lb))] + +val pack_inspect_lb (lb:R.letbinding) + : Lemma (ensures R.pack_lb (R.inspect_lb lb) == lb) + [SMTPat (R.pack_lb (R.inspect_lb lb))] + +val inspect_pack_sigelt (sev:R.sigelt_view { ~ (Unk? sev) }) + : Lemma (ensures R.inspect_sigelt (R.pack_sigelt sev) == sev) + [SMTPat (R.inspect_sigelt (R.pack_sigelt sev))] + +val pack_inspect_sigelt (se:R.sigelt) + : Lemma (requires ~ (Unk? (R.inspect_sigelt se))) + (ensures R.pack_sigelt (R.inspect_sigelt se) == se) + [SMTPat (R.pack_sigelt (R.inspect_sigelt se))] + val lookup_bvar (e:env) (x:int) : option term val lookup_fvar_uinst (e:R.env) (x:R.fv) (us:list R.universe) : option R.term @@ -1791,18 +1808,38 @@ type sigelt_typing : env -> sigelt -> Type0 = * *) let blob = string & R.term -(* If checked is true, this sigelt is properly typed for the environment. If not, -we don't know and let F* re-typecheck the sigelt. *) -let sigelt_for (g:env) = - tup:(bool & sigelt & option blob) - { + +let sigelt_has_type (s:R.sigelt) (t:option R.term) : prop = + let open R in + match t with + | None -> True + | Some t -> + match inspect_sigelt s with + | Sg_Let false [lb] -> begin + let {lb_typ} = inspect_lb lb in + lb_typ == t + end + + | _ -> False + +// +// If checked is true, this sigelt is properly typed for the environment +// If not, we don't know and let F* re-typecheck the sigelt. +// + +let sigelt_for (g:env) (t:option R.typ) = + tup:(bool & sigelt & option blob) { let (checked, se, _) = tup in - checked ==> sigelt_typing g se + checked ==> (sigelt_typing g se /\ sigelt_has_type se t) } -let dsl_tac_result_t (g:env) = list (sigelt_for g) +let dsl_tac_result_t (g:env) (t:option R.typ) = + list (sigelt_for g None) & + (sigelt_for g t) & + list (sigelt_for g None) -type dsl_tac_t = g:fstar_top_env -> T.Tac (dsl_tac_result_t g) +type dsl_tac_t = + gt:(fstar_top_env & option R.typ) -> T.Tac (dsl_tac_result_t (fst gt) (snd gt)) val if_complete_match (g:env) (t:term) : T.match_complete_token g t bool_ty [ @@ -1829,8 +1866,9 @@ val mkif : typing g (mk_if scrutinee then_ else_) (eff, ty) (* Helper to return a single let definition in a splice_t tactic. *) -let mk_checked_let (g:R.env) (nm:string) (tm:R.term) (ty:R.typ{typing g tm (T.E_Total, ty)}) : T.Tac (sigelt_for g) = - let fv = pack_fv (T.cur_module () @ [nm]) in +let mk_checked_let (g:R.env) (cur_module:name) (nm:string) (tm:R.term) (ty:R.typ{typing g tm (T.E_Total, ty)}) + : sigelt_for g (Some ty) = + let fv = pack_fv (cur_module @ [nm]) in let lb = R.pack_lb ({ lb_fv = fv; lb_us = []; lb_typ = ty; lb_def = tm }) in let se = R.pack_sigelt (R.Sg_Let false [lb]) in let pf : sigelt_typing g se = @@ -1838,8 +1876,9 @@ let mk_checked_let (g:R.env) (nm:string) (tm:R.term) (ty:R.typ{typing g tm (T.E_ in ( true, se, None ) -let mk_unchecked_let (g:R.env) (nm:string) (tm:R.term) (ty:R.typ) : T.Tac (sigelt_for g) = - let fv = pack_fv (T.cur_module () @ [nm]) in +let mk_unchecked_let (g:R.env) (cur_module:name) (nm:string) (tm:R.term) (ty:R.typ) + : bool & sigelt & option blob = + let fv = pack_fv (cur_module @ [nm]) in let lb = R.pack_lb ({ lb_fv = fv; lb_us = []; lb_typ = ty; lb_def = tm }) in let se = R.pack_sigelt (R.Sg_Let false [lb]) in ( false, se, None ) From e96f775f4861ac694cf3da5944308977a1229c72 Mon Sep 17 00:00:00 2001 From: Aseem Rastogi Date: Fri, 26 Apr 2024 04:47:33 +0000 Subject: [PATCH 102/239] when invoking the dsl checker tactics, if there is a val, pass its type as the expected type --- src/tactics/FStar.Tactics.Hooks.fst | 77 ++++++++++++++++++++--------- 1 file changed, 55 insertions(+), 22 deletions(-) diff --git a/src/tactics/FStar.Tactics.Hooks.fst b/src/tactics/FStar.Tactics.Hooks.fst index c11516170fa..8dc2b8cff5f 100644 --- a/src/tactics/FStar.Tactics.Hooks.fst +++ b/src/tactics/FStar.Tactics.Hooks.fst @@ -818,7 +818,13 @@ let handle_smt_goal env goal = (* No such tactic was available in the current context *) | None -> [env, goal] -let splice (env:Env.env) (is_typed:bool) (lids:list Ident.lident) (tau:term) (rng:Range.range) : list sigelt = +let splice + (env:Env.env) + (is_typed:bool) + (lids:list Ident.lident) + (tau:term) + (rng:Range.range) : list sigelt = + Errors.with_ctx "While running splice with a tactic" (fun () -> if env.nosynth then [] else begin tacdbg := Env.debug env (O.Other "Tac"); @@ -836,27 +842,54 @@ let splice (env:Env.env) (is_typed:bool) (lids:list Ident.lident) (tau:term) (rn let gs, sigelts = if is_typed then begin - let e_blob = e_option (e_tuple2 e_string RE.e_term) in - let gs, sig_blobs = run_tactic_on_ps tau.pos tau.pos false - RE.e_env - {env with gamma=[]} - (e_list (e_tuple3 e_bool RE.e_sigelt e_blob)) - tau - tactic_already_typed - ps - in - let sigelts = sig_blobs |> map (fun (checked, se, blob_opt) -> - { se with - sigmeta = { se.sigmeta with - sigmeta_extension_data = - (match blob_opt with - | Some (s, blob) -> [s, Dyn.mkdyn blob] - | None -> []); - sigmeta_already_checked = checked; } - } - ) - in - gs, sigelts + if List.length lids > 1 + then let s = lids |> List.map Ident.string_of_lid |> BU.concat_l ", " in + Err.raise_error + (Errors.Error_BadSplice, + BU.format1 "Typed splice: unexpected lids length (> 1) (%s)" (show lids)) + rng + else begin + let val_t = + if List.length lids = 0 + then None + else + match Env.try_lookup_val_decl env (List.hd lids) with + | None -> None + | Some ((uvs, tval), _) -> + if List.length uvs <> 0 + then + Err.raise_error + (Errors.Error_BadSplice, + BU.format1 "Typed splice: val declaration for %s is universe polymorphic in %s universes, expected 0" + (string_of_int (List.length uvs))) + rng + else Some tval in + let e_blob = e_option (e_tuple2 e_string RE.e_term) in + let gs, (sig_blobs_before, sig_blob, sig_blobs_after) = run_tactic_on_ps tau.pos tau.pos false + (e_tuple2 RE.e_env (e_option RE.e_term)) + ({env with gamma=[]}, val_t) + (e_tuple3 + (e_list (e_tuple3 e_bool RE.e_sigelt e_blob)) + (e_tuple3 e_bool RE.e_sigelt e_blob) + (e_list (e_tuple3 e_bool RE.e_sigelt e_blob))) + tau + tactic_already_typed + ps + in + let sig_blobs = sig_blobs_before@(sig_blob::sig_blobs_after) in + let sigelts = sig_blobs |> map (fun (checked, se, blob_opt) -> + { se with + sigmeta = { se.sigmeta with + sigmeta_extension_data = + (match blob_opt with + | Some (s, blob) -> [s, Dyn.mkdyn blob] + | None -> []); + sigmeta_already_checked = checked; } + } + ) + in + gs, sigelts + end end else run_tactic_on_ps tau.pos tau.pos false e_unit () From 84c6d775616acb650c8e110a6123f06c44d258ad Mon Sep 17 00:00:00 2001 From: Aseem Rastogi Date: Fri, 26 Apr 2024 04:47:39 +0000 Subject: [PATCH 103/239] snap --- .../generated/FStar_Parser_AST_Util.ml | 30 +- .../generated/FStar_Reflection_Typing.ml | 194 +++---- .../generated/FStar_Tactics_Hooks.ml | 472 +++++++++++------- .../generated/FStar_ToSyntax_Interleave.ml | 23 + .../generated/FStar_ToSyntax_ToSyntax.ml | 3 +- 5 files changed, 390 insertions(+), 332 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Parser_AST_Util.ml b/ocaml/fstar-lib/generated/FStar_Parser_AST_Util.ml index c210332f98b..c3aac1c6178 100644 --- a/ocaml/fstar-lib/generated/FStar_Parser_AST_Util.ml +++ b/ocaml/fstar-lib/generated/FStar_Parser_AST_Util.ml @@ -1071,10 +1071,36 @@ let (__proj__Mkerror_message__item__range : error_message -> FStar_Compiler_Range_Type.range) = fun projectee -> match projectee with | { message; range;_} -> range type extension_parser = - open_namespaces_and_abbreviations -> + { + parse_decl_name: Prims.string -> FStar_Compiler_Range_Type.range -> - (error_message, FStar_Parser_AST.decl) FStar_Pervasives.either + (error_message, FStar_Ident.ident) FStar_Pervasives.either + ; + parse_decl: + open_namespaces_and_abbreviations -> + Prims.string -> + FStar_Compiler_Range_Type.range -> + (error_message, FStar_Parser_AST.decl) FStar_Pervasives.either + } +let (__proj__Mkextension_parser__item__parse_decl_name : + extension_parser -> + Prims.string -> + FStar_Compiler_Range_Type.range -> + (error_message, FStar_Ident.ident) FStar_Pervasives.either) + = + fun projectee -> + match projectee with + | { parse_decl_name; parse_decl;_} -> parse_decl_name +let (__proj__Mkextension_parser__item__parse_decl : + extension_parser -> + open_namespaces_and_abbreviations -> + Prims.string -> + FStar_Compiler_Range_Type.range -> + (error_message, FStar_Parser_AST.decl) FStar_Pervasives.either) + = + fun projectee -> + match projectee with | { parse_decl_name; parse_decl;_} -> parse_decl let (extension_parser_table : extension_parser FStar_Compiler_Util.smap) = FStar_Compiler_Util.smap_create (Prims.of_int (20)) let (register_extension_parser : Prims.string -> extension_parser -> unit) = diff --git a/ocaml/fstar-lib/generated/FStar_Reflection_Typing.ml b/ocaml/fstar-lib/generated/FStar_Reflection_Typing.ml index 5e74410f138..7d5787a8e72 100644 --- a/ocaml/fstar-lib/generated/FStar_Reflection_Typing.ml +++ b/ocaml/fstar-lib/generated/FStar_Reflection_Typing.ml @@ -1652,13 +1652,16 @@ let (__proj__ST_Let_Opaque__item__ty : fun projectee -> match projectee with | ST_Let_Opaque (g, fv, ty, _3) -> ty type blob = (Prims.string * FStar_Reflection_Types.term) -type 'g sigelt_for = +type ('s, 't) sigelt_has_type = Obj.t +type ('g, 't) sigelt_for = (Prims.bool * FStar_Reflection_Types.sigelt * blob FStar_Pervasives_Native.option) -type 'g dsl_tac_result_t = unit sigelt_for Prims.list +type ('g, 't) dsl_tac_result_t = + ((unit, unit) sigelt_for Prims.list * (unit, unit) sigelt_for * (unit, + unit) sigelt_for Prims.list) type dsl_tac_t = - fstar_top_env -> - (unit dsl_tac_result_t, unit) FStar_Tactics_Effect.tac_repr + (fstar_top_env * FStar_Reflection_Types.typ FStar_Pervasives_Native.option) + -> ((unit, unit) dsl_tac_result_t, unit) FStar_Tactics_Effect.tac_repr let (if_complete_match : FStar_Reflection_Types.env -> FStar_Reflection_Types.term -> @@ -1734,146 +1737,61 @@ let (mkif : (brty ())) let (mk_checked_let : FStar_Reflection_Types.env -> - Prims.string -> - FStar_Reflection_Types.term -> - FStar_Reflection_Types.typ -> - (unit sigelt_for, unit) FStar_Tactics_Effect.tac_repr) + FStar_Reflection_Types.name -> + Prims.string -> + FStar_Reflection_Types.term -> + FStar_Reflection_Types.typ -> (unit, unit) sigelt_for) = fun g -> - fun nm -> - fun tm -> - fun ty -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Reflection.Typing.fsti" - (Prims.of_int (1833)) (Prims.of_int (11)) - (Prims.of_int (1833)) (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Reflection.Typing.fsti" - (Prims.of_int (1833)) (Prims.of_int (46)) - (Prims.of_int (1839)) (Prims.of_int (20))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Reflection.Typing.fsti" - (Prims.of_int (1833)) (Prims.of_int (19)) - (Prims.of_int (1833)) (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Reflection.Typing.fsti" - (Prims.of_int (1833)) (Prims.of_int (11)) - (Prims.of_int (1833)) (Prims.of_int (43))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Reflection.Typing.fsti" - (Prims.of_int (1833)) (Prims.of_int (20)) - (Prims.of_int (1833)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Reflection.Typing.fsti" - (Prims.of_int (1833)) (Prims.of_int (19)) - (Prims.of_int (1833)) (Prims.of_int (43))))) - (Obj.magic (FStar_Tactics_V2_Derived.cur_module ())) - (fun uu___ -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_List_Tot_Base.op_At uu___ [nm])))) - (fun uu___ -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_Reflection_V2_Builtins.pack_fv uu___)))) - (fun fv -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - (true, - (FStar_Reflection_V2_Builtins.pack_sigelt - (FStar_Reflection_V2_Data.Sg_Let - (false, - [FStar_Reflection_V2_Builtins.pack_lb - { - FStar_Reflection_V2_Data.lb_fv = fv; - FStar_Reflection_V2_Data.lb_us = []; - FStar_Reflection_V2_Data.lb_typ = ty; - FStar_Reflection_V2_Data.lb_def = tm - }]))), FStar_Pervasives_Native.None))) + fun cur_module -> + fun nm -> + fun tm -> + fun ty -> + let fv = + FStar_Reflection_V2_Builtins.pack_fv + (FStar_List_Tot_Base.op_At cur_module [nm]) in + let lb = + FStar_Reflection_V2_Builtins.pack_lb + { + FStar_Reflection_V2_Data.lb_fv = fv; + FStar_Reflection_V2_Data.lb_us = []; + FStar_Reflection_V2_Data.lb_typ = ty; + FStar_Reflection_V2_Data.lb_def = tm + } in + let se = + FStar_Reflection_V2_Builtins.pack_sigelt + (FStar_Reflection_V2_Data.Sg_Let (false, [lb])) in + let pf = ST_Let (g, fv, ty, tm, ()) in + (true, se, FStar_Pervasives_Native.None) let (mk_unchecked_let : FStar_Reflection_Types.env -> - Prims.string -> - FStar_Reflection_Types.term -> - FStar_Reflection_Types.typ -> - (unit sigelt_for, unit) FStar_Tactics_Effect.tac_repr) + FStar_Reflection_Types.name -> + Prims.string -> + FStar_Reflection_Types.term -> + FStar_Reflection_Types.typ -> + (Prims.bool * FStar_Reflection_Types.sigelt * blob + FStar_Pervasives_Native.option)) = fun g -> - fun nm -> - fun tm -> - fun ty -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Reflection.Typing.fsti" - (Prims.of_int (1842)) (Prims.of_int (11)) - (Prims.of_int (1842)) (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Reflection.Typing.fsti" - (Prims.of_int (1842)) (Prims.of_int (46)) - (Prims.of_int (1845)) (Prims.of_int (21))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Reflection.Typing.fsti" - (Prims.of_int (1842)) (Prims.of_int (19)) - (Prims.of_int (1842)) (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Reflection.Typing.fsti" - (Prims.of_int (1842)) (Prims.of_int (11)) - (Prims.of_int (1842)) (Prims.of_int (43))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Reflection.Typing.fsti" - (Prims.of_int (1842)) (Prims.of_int (20)) - (Prims.of_int (1842)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Reflection.Typing.fsti" - (Prims.of_int (1842)) (Prims.of_int (19)) - (Prims.of_int (1842)) (Prims.of_int (43))))) - (Obj.magic (FStar_Tactics_V2_Derived.cur_module ())) - (fun uu___ -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_List_Tot_Base.op_At uu___ [nm])))) - (fun uu___ -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_Reflection_V2_Builtins.pack_fv uu___)))) - (fun fv -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - (false, - (FStar_Reflection_V2_Builtins.pack_sigelt - (FStar_Reflection_V2_Data.Sg_Let - (false, - [FStar_Reflection_V2_Builtins.pack_lb - { - FStar_Reflection_V2_Data.lb_fv = fv; - FStar_Reflection_V2_Data.lb_us = []; - FStar_Reflection_V2_Data.lb_typ = ty; - FStar_Reflection_V2_Data.lb_def = tm - }]))), FStar_Pervasives_Native.None))) + fun cur_module -> + fun nm -> + fun tm -> + fun ty -> + let fv = + FStar_Reflection_V2_Builtins.pack_fv + (FStar_List_Tot_Base.op_At cur_module [nm]) in + let lb = + FStar_Reflection_V2_Builtins.pack_lb + { + FStar_Reflection_V2_Data.lb_fv = fv; + FStar_Reflection_V2_Data.lb_us = []; + FStar_Reflection_V2_Data.lb_typ = ty; + FStar_Reflection_V2_Data.lb_def = tm + } in + let se = + FStar_Reflection_V2_Builtins.pack_sigelt + (FStar_Reflection_V2_Data.Sg_Let (false, [lb])) in + (false, se, FStar_Pervasives_Native.None) let (typing_to_token : FStar_Reflection_Types.env -> FStar_Reflection_Types.term -> diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml index 13327a01148..b4df33e30af 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml @@ -1812,197 +1812,287 @@ let (splice : let uu___6 = if is_typed then - let e_blob = - FStar_Syntax_Embeddings.e_option - (FStar_Syntax_Embeddings.e_tuple2 - FStar_Syntax_Embeddings.e_string - FStar_Reflection_V2_Embeddings.e_term) in - let uu___7 = - FStar_Tactics_Interpreter.run_tactic_on_ps - tau1.FStar_Syntax_Syntax.pos - tau1.FStar_Syntax_Syntax.pos false - FStar_Reflection_V2_Embeddings.e_env - { - FStar_TypeChecker_Env.solver = - (env.FStar_TypeChecker_Env.solver); - FStar_TypeChecker_Env.range = - (env.FStar_TypeChecker_Env.range); - FStar_TypeChecker_Env.curmodule = - (env.FStar_TypeChecker_Env.curmodule); - FStar_TypeChecker_Env.gamma = []; - FStar_TypeChecker_Env.gamma_sig = - (env.FStar_TypeChecker_Env.gamma_sig); - FStar_TypeChecker_Env.gamma_cache = - (env.FStar_TypeChecker_Env.gamma_cache); - FStar_TypeChecker_Env.modules = - (env.FStar_TypeChecker_Env.modules); - FStar_TypeChecker_Env.expected_typ = - (env.FStar_TypeChecker_Env.expected_typ); - FStar_TypeChecker_Env.sigtab = - (env.FStar_TypeChecker_Env.sigtab); - FStar_TypeChecker_Env.attrtab = - (env.FStar_TypeChecker_Env.attrtab); - FStar_TypeChecker_Env.instantiate_imp = - (env.FStar_TypeChecker_Env.instantiate_imp); - FStar_TypeChecker_Env.effects = - (env.FStar_TypeChecker_Env.effects); - FStar_TypeChecker_Env.generalize = - (env.FStar_TypeChecker_Env.generalize); - FStar_TypeChecker_Env.letrecs = - (env.FStar_TypeChecker_Env.letrecs); - FStar_TypeChecker_Env.top_level = - (env.FStar_TypeChecker_Env.top_level); - FStar_TypeChecker_Env.check_uvars = - (env.FStar_TypeChecker_Env.check_uvars); - FStar_TypeChecker_Env.use_eq_strict = - (env.FStar_TypeChecker_Env.use_eq_strict); - FStar_TypeChecker_Env.is_iface = - (env.FStar_TypeChecker_Env.is_iface); - FStar_TypeChecker_Env.admit = - (env.FStar_TypeChecker_Env.admit); - FStar_TypeChecker_Env.lax = - (env.FStar_TypeChecker_Env.lax); - FStar_TypeChecker_Env.lax_universes = - (env.FStar_TypeChecker_Env.lax_universes); - FStar_TypeChecker_Env.phase1 = - (env.FStar_TypeChecker_Env.phase1); - FStar_TypeChecker_Env.failhard = - (env.FStar_TypeChecker_Env.failhard); - FStar_TypeChecker_Env.nosynth = - (env.FStar_TypeChecker_Env.nosynth); - FStar_TypeChecker_Env.uvar_subtyping = - (env.FStar_TypeChecker_Env.uvar_subtyping); - FStar_TypeChecker_Env.intactics = - (env.FStar_TypeChecker_Env.intactics); - FStar_TypeChecker_Env.nocoerce = - (env.FStar_TypeChecker_Env.nocoerce); - FStar_TypeChecker_Env.tc_term = - (env.FStar_TypeChecker_Env.tc_term); - FStar_TypeChecker_Env.typeof_tot_or_gtot_term - = - (env.FStar_TypeChecker_Env.typeof_tot_or_gtot_term); - FStar_TypeChecker_Env.universe_of = - (env.FStar_TypeChecker_Env.universe_of); - FStar_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term - = - (env.FStar_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term); - FStar_TypeChecker_Env.teq_nosmt_force = - (env.FStar_TypeChecker_Env.teq_nosmt_force); - FStar_TypeChecker_Env.subtype_nosmt_force - = - (env.FStar_TypeChecker_Env.subtype_nosmt_force); - FStar_TypeChecker_Env.qtbl_name_and_index - = - (env.FStar_TypeChecker_Env.qtbl_name_and_index); - FStar_TypeChecker_Env.normalized_eff_names - = - (env.FStar_TypeChecker_Env.normalized_eff_names); - FStar_TypeChecker_Env.fv_delta_depths = - (env.FStar_TypeChecker_Env.fv_delta_depths); - FStar_TypeChecker_Env.proof_ns = - (env.FStar_TypeChecker_Env.proof_ns); - FStar_TypeChecker_Env.synth_hook = - (env.FStar_TypeChecker_Env.synth_hook); - FStar_TypeChecker_Env.try_solve_implicits_hook - = - (env.FStar_TypeChecker_Env.try_solve_implicits_hook); - FStar_TypeChecker_Env.splice = - (env.FStar_TypeChecker_Env.splice); - FStar_TypeChecker_Env.mpreprocess = - (env.FStar_TypeChecker_Env.mpreprocess); - FStar_TypeChecker_Env.postprocess = - (env.FStar_TypeChecker_Env.postprocess); - FStar_TypeChecker_Env.identifier_info = - (env.FStar_TypeChecker_Env.identifier_info); - FStar_TypeChecker_Env.tc_hooks = - (env.FStar_TypeChecker_Env.tc_hooks); - FStar_TypeChecker_Env.dsenv = - (env.FStar_TypeChecker_Env.dsenv); - FStar_TypeChecker_Env.nbe = - (env.FStar_TypeChecker_Env.nbe); - FStar_TypeChecker_Env.strict_args_tab = - (env.FStar_TypeChecker_Env.strict_args_tab); - FStar_TypeChecker_Env.erasable_types_tab - = - (env.FStar_TypeChecker_Env.erasable_types_tab); - FStar_TypeChecker_Env.enable_defer_to_tac - = - (env.FStar_TypeChecker_Env.enable_defer_to_tac); - FStar_TypeChecker_Env.unif_allow_ref_guards - = - (env.FStar_TypeChecker_Env.unif_allow_ref_guards); - FStar_TypeChecker_Env.erase_erasable_args - = - (env.FStar_TypeChecker_Env.erase_erasable_args); - FStar_TypeChecker_Env.core_check = - (env.FStar_TypeChecker_Env.core_check) - } - (FStar_Syntax_Embeddings.e_list - (FStar_Syntax_Embeddings.e_tuple3 - FStar_Syntax_Embeddings.e_bool - FStar_Reflection_V2_Embeddings.e_sigelt - e_blob)) tau1 tactic_already_typed - ps in - match uu___7 with - | (gs, sig_blobs) -> - let sigelts = - FStar_Compiler_List.map - (fun uu___8 -> - match uu___8 with - | (checked, se, blob_opt) -> - let uu___9 = - let uu___10 = - se.FStar_Syntax_Syntax.sigmeta in - let uu___11 = - match blob_opt with - | FStar_Pervasives_Native.Some - (s, blob) -> - let uu___12 = - let uu___13 = - FStar_Compiler_Dyn.mkdyn - blob in - (s, uu___13) in - [uu___12] - | FStar_Pervasives_Native.None - -> [] in - { - FStar_Syntax_Syntax.sigmeta_active - = - (uu___10.FStar_Syntax_Syntax.sigmeta_active); - FStar_Syntax_Syntax.sigmeta_fact_db_ids - = - (uu___10.FStar_Syntax_Syntax.sigmeta_fact_db_ids); - FStar_Syntax_Syntax.sigmeta_admit - = - (uu___10.FStar_Syntax_Syntax.sigmeta_admit); - FStar_Syntax_Syntax.sigmeta_spliced - = - (uu___10.FStar_Syntax_Syntax.sigmeta_spliced); - FStar_Syntax_Syntax.sigmeta_already_checked - = checked; - FStar_Syntax_Syntax.sigmeta_extension_data - = uu___11 - } in - { - FStar_Syntax_Syntax.sigel = - (se.FStar_Syntax_Syntax.sigel); - FStar_Syntax_Syntax.sigrng = - (se.FStar_Syntax_Syntax.sigrng); - FStar_Syntax_Syntax.sigquals - = - (se.FStar_Syntax_Syntax.sigquals); - FStar_Syntax_Syntax.sigmeta = - uu___9; - FStar_Syntax_Syntax.sigattrs - = - (se.FStar_Syntax_Syntax.sigattrs); - FStar_Syntax_Syntax.sigopens_and_abbrevs - = - (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); - FStar_Syntax_Syntax.sigopts = - (se.FStar_Syntax_Syntax.sigopts) - }) sig_blobs in - (gs, sigelts) + (if + (FStar_Compiler_List.length lids) > + Prims.int_one + then + let s = + let uu___7 = + FStar_Compiler_List.map + FStar_Ident.string_of_lid lids in + FStar_Compiler_Util.concat_l ", " uu___7 in + let uu___7 = + let uu___8 = + let uu___9 = + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Ident.showable_lident) + lids in + FStar_Compiler_Util.format1 + "Typed splice: unexpected lids length (> 1) (%s)" + uu___9 in + (FStar_Errors_Codes.Error_BadSplice, + uu___8) in + FStar_Errors.raise_error uu___7 rng + else + (let val_t = + if + (FStar_Compiler_List.length lids) = + Prims.int_zero + then FStar_Pervasives_Native.None + else + (let uu___9 = + let uu___10 = + FStar_Compiler_List.hd lids in + FStar_TypeChecker_Env.try_lookup_val_decl + env uu___10 in + match uu___9 with + | FStar_Pervasives_Native.None -> + FStar_Pervasives_Native.None + | FStar_Pervasives_Native.Some + ((uvs, tval), uu___10) -> + if + (FStar_Compiler_List.length uvs) + <> Prims.int_zero + then + let uu___11 = + let uu___12 = + let uu___13 = + FStar_Compiler_Util.string_of_int + (FStar_Compiler_List.length + uvs) in + FStar_Compiler_Util.format1 + "Typed splice: val declaration for %s is universe polymorphic in %s universes, expected 0" + uu___13 in + (FStar_Errors_Codes.Error_BadSplice, + uu___12) in + FStar_Errors.raise_error + uu___11 rng + else + FStar_Pervasives_Native.Some + tval) in + let e_blob = + FStar_Syntax_Embeddings.e_option + (FStar_Syntax_Embeddings.e_tuple2 + FStar_Syntax_Embeddings.e_string + FStar_Reflection_V2_Embeddings.e_term) in + let uu___8 = + FStar_Tactics_Interpreter.run_tactic_on_ps + tau1.FStar_Syntax_Syntax.pos + tau1.FStar_Syntax_Syntax.pos false + (FStar_Syntax_Embeddings.e_tuple2 + FStar_Reflection_V2_Embeddings.e_env + (FStar_Syntax_Embeddings.e_option + FStar_Reflection_V2_Embeddings.e_term)) + ({ + FStar_TypeChecker_Env.solver = + (env.FStar_TypeChecker_Env.solver); + FStar_TypeChecker_Env.range = + (env.FStar_TypeChecker_Env.range); + FStar_TypeChecker_Env.curmodule = + (env.FStar_TypeChecker_Env.curmodule); + FStar_TypeChecker_Env.gamma = []; + FStar_TypeChecker_Env.gamma_sig = + (env.FStar_TypeChecker_Env.gamma_sig); + FStar_TypeChecker_Env.gamma_cache = + (env.FStar_TypeChecker_Env.gamma_cache); + FStar_TypeChecker_Env.modules = + (env.FStar_TypeChecker_Env.modules); + FStar_TypeChecker_Env.expected_typ + = + (env.FStar_TypeChecker_Env.expected_typ); + FStar_TypeChecker_Env.sigtab = + (env.FStar_TypeChecker_Env.sigtab); + FStar_TypeChecker_Env.attrtab = + (env.FStar_TypeChecker_Env.attrtab); + FStar_TypeChecker_Env.instantiate_imp + = + (env.FStar_TypeChecker_Env.instantiate_imp); + FStar_TypeChecker_Env.effects = + (env.FStar_TypeChecker_Env.effects); + FStar_TypeChecker_Env.generalize = + (env.FStar_TypeChecker_Env.generalize); + FStar_TypeChecker_Env.letrecs = + (env.FStar_TypeChecker_Env.letrecs); + FStar_TypeChecker_Env.top_level = + (env.FStar_TypeChecker_Env.top_level); + FStar_TypeChecker_Env.check_uvars = + (env.FStar_TypeChecker_Env.check_uvars); + FStar_TypeChecker_Env.use_eq_strict + = + (env.FStar_TypeChecker_Env.use_eq_strict); + FStar_TypeChecker_Env.is_iface = + (env.FStar_TypeChecker_Env.is_iface); + FStar_TypeChecker_Env.admit = + (env.FStar_TypeChecker_Env.admit); + FStar_TypeChecker_Env.lax = + (env.FStar_TypeChecker_Env.lax); + FStar_TypeChecker_Env.lax_universes + = + (env.FStar_TypeChecker_Env.lax_universes); + FStar_TypeChecker_Env.phase1 = + (env.FStar_TypeChecker_Env.phase1); + FStar_TypeChecker_Env.failhard = + (env.FStar_TypeChecker_Env.failhard); + FStar_TypeChecker_Env.nosynth = + (env.FStar_TypeChecker_Env.nosynth); + FStar_TypeChecker_Env.uvar_subtyping + = + (env.FStar_TypeChecker_Env.uvar_subtyping); + FStar_TypeChecker_Env.intactics = + (env.FStar_TypeChecker_Env.intactics); + FStar_TypeChecker_Env.nocoerce = + (env.FStar_TypeChecker_Env.nocoerce); + FStar_TypeChecker_Env.tc_term = + (env.FStar_TypeChecker_Env.tc_term); + FStar_TypeChecker_Env.typeof_tot_or_gtot_term + = + (env.FStar_TypeChecker_Env.typeof_tot_or_gtot_term); + FStar_TypeChecker_Env.universe_of = + (env.FStar_TypeChecker_Env.universe_of); + FStar_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term + = + (env.FStar_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term); + FStar_TypeChecker_Env.teq_nosmt_force + = + (env.FStar_TypeChecker_Env.teq_nosmt_force); + FStar_TypeChecker_Env.subtype_nosmt_force + = + (env.FStar_TypeChecker_Env.subtype_nosmt_force); + FStar_TypeChecker_Env.qtbl_name_and_index + = + (env.FStar_TypeChecker_Env.qtbl_name_and_index); + FStar_TypeChecker_Env.normalized_eff_names + = + (env.FStar_TypeChecker_Env.normalized_eff_names); + FStar_TypeChecker_Env.fv_delta_depths + = + (env.FStar_TypeChecker_Env.fv_delta_depths); + FStar_TypeChecker_Env.proof_ns = + (env.FStar_TypeChecker_Env.proof_ns); + FStar_TypeChecker_Env.synth_hook = + (env.FStar_TypeChecker_Env.synth_hook); + FStar_TypeChecker_Env.try_solve_implicits_hook + = + (env.FStar_TypeChecker_Env.try_solve_implicits_hook); + FStar_TypeChecker_Env.splice = + (env.FStar_TypeChecker_Env.splice); + FStar_TypeChecker_Env.mpreprocess = + (env.FStar_TypeChecker_Env.mpreprocess); + FStar_TypeChecker_Env.postprocess = + (env.FStar_TypeChecker_Env.postprocess); + FStar_TypeChecker_Env.identifier_info + = + (env.FStar_TypeChecker_Env.identifier_info); + FStar_TypeChecker_Env.tc_hooks = + (env.FStar_TypeChecker_Env.tc_hooks); + FStar_TypeChecker_Env.dsenv = + (env.FStar_TypeChecker_Env.dsenv); + FStar_TypeChecker_Env.nbe = + (env.FStar_TypeChecker_Env.nbe); + FStar_TypeChecker_Env.strict_args_tab + = + (env.FStar_TypeChecker_Env.strict_args_tab); + FStar_TypeChecker_Env.erasable_types_tab + = + (env.FStar_TypeChecker_Env.erasable_types_tab); + FStar_TypeChecker_Env.enable_defer_to_tac + = + (env.FStar_TypeChecker_Env.enable_defer_to_tac); + FStar_TypeChecker_Env.unif_allow_ref_guards + = + (env.FStar_TypeChecker_Env.unif_allow_ref_guards); + FStar_TypeChecker_Env.erase_erasable_args + = + (env.FStar_TypeChecker_Env.erase_erasable_args); + FStar_TypeChecker_Env.core_check = + (env.FStar_TypeChecker_Env.core_check) + }, val_t) + (FStar_Syntax_Embeddings.e_tuple3 + (FStar_Syntax_Embeddings.e_list + (FStar_Syntax_Embeddings.e_tuple3 + FStar_Syntax_Embeddings.e_bool + FStar_Reflection_V2_Embeddings.e_sigelt + e_blob)) + (FStar_Syntax_Embeddings.e_tuple3 + FStar_Syntax_Embeddings.e_bool + FStar_Reflection_V2_Embeddings.e_sigelt + e_blob) + (FStar_Syntax_Embeddings.e_list + (FStar_Syntax_Embeddings.e_tuple3 + FStar_Syntax_Embeddings.e_bool + FStar_Reflection_V2_Embeddings.e_sigelt + e_blob))) tau1 + tactic_already_typed ps in + match uu___8 with + | (gs, + (sig_blobs_before, sig_blob, + sig_blobs_after)) -> + let sig_blobs = + FStar_Compiler_List.op_At + sig_blobs_before (sig_blob :: + sig_blobs_after) in + let sigelts = + FStar_Compiler_List.map + (fun uu___9 -> + match uu___9 with + | (checked, se, blob_opt) -> + let uu___10 = + let uu___11 = + se.FStar_Syntax_Syntax.sigmeta in + let uu___12 = + match blob_opt with + | FStar_Pervasives_Native.Some + (s, blob) -> + let uu___13 = + let uu___14 = + FStar_Compiler_Dyn.mkdyn + blob in + (s, uu___14) in + [uu___13] + | FStar_Pervasives_Native.None + -> [] in + { + FStar_Syntax_Syntax.sigmeta_active + = + (uu___11.FStar_Syntax_Syntax.sigmeta_active); + FStar_Syntax_Syntax.sigmeta_fact_db_ids + = + (uu___11.FStar_Syntax_Syntax.sigmeta_fact_db_ids); + FStar_Syntax_Syntax.sigmeta_admit + = + (uu___11.FStar_Syntax_Syntax.sigmeta_admit); + FStar_Syntax_Syntax.sigmeta_spliced + = + (uu___11.FStar_Syntax_Syntax.sigmeta_spliced); + FStar_Syntax_Syntax.sigmeta_already_checked + = checked; + FStar_Syntax_Syntax.sigmeta_extension_data + = uu___12 + } in + { + FStar_Syntax_Syntax.sigel + = + (se.FStar_Syntax_Syntax.sigel); + FStar_Syntax_Syntax.sigrng + = + (se.FStar_Syntax_Syntax.sigrng); + FStar_Syntax_Syntax.sigquals + = + (se.FStar_Syntax_Syntax.sigquals); + FStar_Syntax_Syntax.sigmeta + = uu___10; + FStar_Syntax_Syntax.sigattrs + = + (se.FStar_Syntax_Syntax.sigattrs); + FStar_Syntax_Syntax.sigopens_and_abbrevs + = + (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); + FStar_Syntax_Syntax.sigopts + = + (se.FStar_Syntax_Syntax.sigopts) + }) sig_blobs in + (gs, sigelts))) else FStar_Tactics_Interpreter.run_tactic_on_ps tau1.FStar_Syntax_Syntax.pos diff --git a/ocaml/fstar-lib/generated/FStar_ToSyntax_Interleave.ml b/ocaml/fstar-lib/generated/FStar_ToSyntax_Interleave.ml index 9778a34b2fb..fdfd1522443 100644 --- a/ocaml/fstar-lib/generated/FStar_ToSyntax_Interleave.ml +++ b/ocaml/fstar-lib/generated/FStar_ToSyntax_Interleave.ml @@ -46,6 +46,29 @@ let (definition_lids : | uu___3 -> []) tys | FStar_Parser_AST.Splice (uu___, ids, uu___1) -> FStar_Compiler_List.map (fun id -> FStar_Ident.lid_of_ids [id]) ids + | FStar_Parser_AST.DeclSyntaxExtension + (extension_name, code, uu___, range) -> + let ext_parser = + FStar_Parser_AST_Util.lookup_extension_parser extension_name in + (match ext_parser with + | FStar_Pervasives_Native.None -> + let uu___1 = + let uu___2 = + FStar_Compiler_Util.format1 "Unknown syntax extension %s" + extension_name in + (FStar_Errors_Codes.Fatal_SyntaxError, uu___2) in + FStar_Errors.raise_error uu___1 d.FStar_Parser_AST.drange + | FStar_Pervasives_Native.Some parser -> + let uu___1 = + parser.FStar_Parser_AST_Util.parse_decl_name code range in + (match uu___1 with + | FStar_Pervasives.Inl error -> + FStar_Errors.raise_error + (FStar_Errors_Codes.Fatal_SyntaxError, + (error.FStar_Parser_AST_Util.message)) + error.FStar_Parser_AST_Util.range + | FStar_Pervasives.Inr id -> + let uu___2 = FStar_Ident.lid_of_ids [id] in [uu___2])) | uu___ -> [] let (is_definition_of : FStar_Ident.ident -> FStar_Parser_AST.decl -> Prims.bool) = diff --git a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml index 710914b9822..e91511a89fb 100644 --- a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml +++ b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml @@ -10150,7 +10150,8 @@ and (desugar_decl_core : FStar_Parser_AST_Util.open_namespaces = uu___1; FStar_Parser_AST_Util.module_abbreviations = uu___2 } in - let uu___1 = parser opens code range in + let uu___1 = + parser.FStar_Parser_AST_Util.parse_decl opens code range in (match uu___1 with | FStar_Pervasives.Inl error -> FStar_Errors.raise_error From 40b09dd8c5d2446f5e7a61e0e0821985d64a692a Mon Sep 17 00:00:00 2001 From: Aseem Rastogi Date: Fri, 26 Apr 2024 09:42:57 +0000 Subject: [PATCH 104/239] snap --- .../generated/FStar_ToSyntax_ToSyntax.ml | 77 ------------------- 1 file changed, 77 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml index e91511a89fb..1fe7d79c2fa 100644 --- a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml +++ b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml @@ -1021,83 +1021,6 @@ let (no_annot_abs : FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax) = fun bs -> fun t -> FStar_Syntax_Util.abs bs t FStar_Pervasives_Native.None -let (mk_ref_read : - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax) - = - fun tm -> - let tm' = - let uu___ = - let uu___1 = - let uu___2 = - FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.sread_lid - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in - FStar_Syntax_Syntax.fv_to_tm uu___2 in - let uu___2 = - let uu___3 = - let uu___4 = FStar_Syntax_Syntax.as_aqual_implicit false in - (tm, uu___4) in - [uu___3] in - { FStar_Syntax_Syntax.hd = uu___1; FStar_Syntax_Syntax.args = uu___2 - } in - FStar_Syntax_Syntax.Tm_app uu___ in - FStar_Syntax_Syntax.mk tm' tm.FStar_Syntax_Syntax.pos -let (mk_ref_alloc : - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax) - = - fun tm -> - let tm' = - let uu___ = - let uu___1 = - let uu___2 = - FStar_Syntax_Syntax.lid_and_dd_as_fv - FStar_Parser_Const.salloc_lid - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in - FStar_Syntax_Syntax.fv_to_tm uu___2 in - let uu___2 = - let uu___3 = - let uu___4 = FStar_Syntax_Syntax.as_aqual_implicit false in - (tm, uu___4) in - [uu___3] in - { FStar_Syntax_Syntax.hd = uu___1; FStar_Syntax_Syntax.args = uu___2 - } in - FStar_Syntax_Syntax.Tm_app uu___ in - FStar_Syntax_Syntax.mk tm' tm.FStar_Syntax_Syntax.pos -let (mk_ref_assign : - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> - FStar_Compiler_Range_Type.range -> - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax) - = - fun t1 -> - fun t2 -> - fun pos -> - let tm = - let uu___ = - let uu___1 = - let uu___2 = - FStar_Syntax_Syntax.lid_and_dd_as_fv - FStar_Parser_Const.swrite_lid - FStar_Syntax_Syntax.delta_constant - FStar_Pervasives_Native.None in - FStar_Syntax_Syntax.fv_to_tm uu___2 in - let uu___2 = - let uu___3 = - let uu___4 = FStar_Syntax_Syntax.as_aqual_implicit false in - (t1, uu___4) in - let uu___4 = - let uu___5 = - let uu___6 = FStar_Syntax_Syntax.as_aqual_implicit false in - (t2, uu___6) in - [uu___5] in - uu___3 :: uu___4 in - { - FStar_Syntax_Syntax.hd = uu___1; - FStar_Syntax_Syntax.args = uu___2 - } in - FStar_Syntax_Syntax.Tm_app uu___ in - FStar_Syntax_Syntax.mk tm pos let rec (generalize_annotated_univs : FStar_Syntax_Syntax.sigelt -> FStar_Syntax_Syntax.sigelt) = fun s -> From 3cfd201d99d1fc7550c6ddfe1dd76211ba4eb7ac Mon Sep 17 00:00:00 2001 From: Aseem Rastogi Date: Fri, 26 Apr 2024 10:01:56 +0000 Subject: [PATCH 105/239] some comments --- src/tactics/FStar.Tactics.Hooks.fst | 15 ++++++- src/tosyntax/FStar.ToSyntax.Interleave.fst | 2 + .../experimental/FStar.Reflection.Typing.fsti | 45 +++++++++++-------- 3 files changed, 43 insertions(+), 19 deletions(-) diff --git a/src/tactics/FStar.Tactics.Hooks.fst b/src/tactics/FStar.Tactics.Hooks.fst index 8dc2b8cff5f..16b2d7d08c4 100644 --- a/src/tactics/FStar.Tactics.Hooks.fst +++ b/src/tactics/FStar.Tactics.Hooks.fst @@ -842,6 +842,9 @@ let splice let gs, sigelts = if is_typed then begin + // + // See if there is a val for the lid + // if List.length lids > 1 then let s = lids |> List.map Ident.string_of_lid |> BU.concat_l ", " in Err.raise_error @@ -849,13 +852,20 @@ let splice BU.format1 "Typed splice: unexpected lids length (> 1) (%s)" (show lids)) rng else begin - let val_t = + let val_t : option typ = // val type, if any, for the lid + // + // For spliced vals, their lids is set to [] + // (see ToSyntax.fst:desugar_decl, splice case) + // if List.length lids = 0 then None else match Env.try_lookup_val_decl env (List.hd lids) with | None -> None | Some ((uvs, tval), _) -> + // + // No universe polymorphic typed splice yet + // if List.length uvs <> 0 then Err.raise_error @@ -865,6 +875,9 @@ let splice rng else Some tval in let e_blob = e_option (e_tuple2 e_string RE.e_term) in + // + // The arguments to run_tactic_on_ps here are in sync with ulib/FStar.Tactics.dsl_tac_t + // let gs, (sig_blobs_before, sig_blob, sig_blobs_after) = run_tactic_on_ps tau.pos tau.pos false (e_tuple2 RE.e_env (e_option RE.e_term)) ({env with gamma=[]}, val_t) diff --git a/src/tosyntax/FStar.ToSyntax.Interleave.fst b/src/tosyntax/FStar.ToSyntax.Interleave.fst index 9108ae88b56..7d0b3a9d0a3 100644 --- a/src/tosyntax/FStar.ToSyntax.Interleave.fst +++ b/src/tosyntax/FStar.ToSyntax.Interleave.fst @@ -40,8 +40,10 @@ let is_type x d = match d.d with tys |> Util.for_some (fun t -> id_of_tycon t = (string_of_id x)) | _ -> false +// //is d of of the form 'let x = ...' or 'type x = ...' or 'splice[..., x, ...] tac' // returns unqualified lids +// let definition_lids d = match d.d with | TopLevelLet(_, defs) -> diff --git a/ulib/experimental/FStar.Reflection.Typing.fsti b/ulib/experimental/FStar.Reflection.Typing.fsti index 2b2be79255d..87b0347e0e7 100644 --- a/ulib/experimental/FStar.Reflection.Typing.fsti +++ b/ulib/experimental/FStar.Reflection.Typing.fsti @@ -1764,13 +1764,8 @@ type fstar_top_env = g:fstar_env { } // -// This doesn't allow for universe polymorphic definitions +// No universe polymorphism yet // -// May be we can change it to: -// -// g:fstar_top_env -> T.tac ((us, e, t):(univ_names & term & typ){typing (push g us) e t}) -// - noeq type sigelt_typing : env -> sigelt -> Type0 = | ST_Let : @@ -1791,24 +1786,31 @@ type sigelt_typing : env -> sigelt -> Type0 = (** * The type of the top-level tactic that would splice-in the definitions. - * It returns a list of well typed definitions, via the judgment above. * - * Each definition can have a 'blob' attached with a given name. + * The tactic takes as input as type environment and an optional expected type + * + * It returns (sigelts_before, sigelt, sigelt_after) + * where sigelts_before and sigelt_after are list of sigelts + * + * All the returned sigelts indicate via a boolean flag whether they are well-typed, + * in the judgment above + * + * If the flag is not set, F* typechecker typechecks the returned sigelts + * + * The sigelt in the middle, if well-typed, has the input expected type + * + * In addition, each sigelt can have a 'blob' attached with a given name. * The blob can be used later, e.g., during extraction, and passed back to the * extension to perform additional processing. - *) - -(* - * It returns either: - * - Some tm, blob, typ, with a proof that `typing g tm typ` - * - None, blob, typ), with a proof that `exists tm. typing g tm typ` - * The blob itself is optional and can store some additional metadata that - * constructed by the tactic. If present, it will be stored in the - * sigmeta_extension_data field of the enclosing sigelt. * + * The blob is stored in the sigmeta_extension_data field of the enclosing sigelt. *) + let blob = string & R.term +// +// t is the optional expected type +// let sigelt_has_type (s:R.sigelt) (t:option R.term) : prop = let open R in match t with @@ -1833,13 +1835,20 @@ let sigelt_for (g:env) (t:option R.typ) = checked ==> (sigelt_typing g se /\ sigelt_has_type se t) } +// +// sigelts_before, sigelt, sigelts_after +// let dsl_tac_result_t (g:env) (t:option R.typ) = list (sigelt_for g None) & (sigelt_for g t) & list (sigelt_for g None) +// +// The input option R.typ is the expected type +// type dsl_tac_t = - gt:(fstar_top_env & option R.typ) -> T.Tac (dsl_tac_result_t (fst gt) (snd gt)) + gt:(fstar_top_env & option R.typ) -> + T.Tac (dsl_tac_result_t (fst gt) (snd gt)) val if_complete_match (g:env) (t:term) : T.match_complete_token g t bool_ty [ From 837509a408fdf1fe559fc64b1c13c68a6d82a834 Mon Sep 17 00:00:00 2001 From: Aseem Rastogi Date: Fri, 26 Apr 2024 16:04:02 +0530 Subject: [PATCH 106/239] interactive tests --- tests/ide/emacs/fstarmode_gh73.out.expected | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/ide/emacs/fstarmode_gh73.out.expected b/tests/ide/emacs/fstarmode_gh73.out.expected index 6a11645c219..60ea334151f 100644 --- a/tests/ide/emacs/fstarmode_gh73.out.expected +++ b/tests/ide/emacs/fstarmode_gh73.out.expected @@ -1,5 +1,5 @@ {"kind": "protocol-info", "rest": "[...]"} -{"kind": "response", "query-id": "1", "response": [{"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(160,0-160,48)\n", "number": 288, "ranges": [{"beg": [135, 17], "end": [135, 24], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [160, 0], "end": [160, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(160,0-160,48)\n", "number": 288, "ranges": [{"beg": [136, 22], "end": [136, 29], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [160, 0], "end": [160, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Adding an implicit 'assume new' qualifier on document\n", "number": 239, "ranges": [{"beg": [36, 5], "end": [36, 13], "fname": "FStar.Stubs.Pprint.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(160,0-160,48)\n", "number": 288, "ranges": [{"beg": [624, 15], "end": [624, 22], "fname": "FStar.Tactics.V2.Derived.fst"}, {"beg": [160, 0], "end": [160, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(160,0-160,48)\n", "number": 288, "ranges": [{"beg": [176, 11], "end": [176, 18], "fname": "FStar.Tactics.V2.Logic.fst"}, {"beg": [160, 0], "end": [160, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Pattern uses these theory symbols or terms that should not be in an smt pattern: Prims.op_Subtraction\n", "number": 271, "ranges": [{"beg": [434, 8], "end": [434, 51], "fname": "FStar.UInt.fsti"}]}], "status": "success"} +{"kind": "response", "query-id": "1", "response": [{"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [135, 17], "end": [135, 24], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [136, 22], "end": [136, 29], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Adding an implicit 'assume new' qualifier on document\n", "number": 239, "ranges": [{"beg": [36, 5], "end": [36, 13], "fname": "FStar.Stubs.Pprint.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [624, 15], "end": [624, 22], "fname": "FStar.Tactics.V2.Derived.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [176, 11], "end": [176, 18], "fname": "FStar.Tactics.V2.Logic.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Pattern uses these theory symbols or terms that should not be in an smt pattern: Prims.op_Subtraction\n", "number": 271, "ranges": [{"beg": [434, 8], "end": [434, 51], "fname": "FStar.UInt.fsti"}]}], "status": "success"} {"kind": "response", "query-id": "2", "response": [{"level": "error", "message": " - Expected expression of type int got expression \"A\" of type string\n", "number": 189, "ranges": [{"beg": [4, 48], "end": [4, 51], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "3", "response": [{"level": "error", "message": " - Expected expression of type int got expression \"A\" of type string\n", "number": 189, "ranges": [{"beg": [4, 48], "end": [4, 51], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "4", "response": [], "status": "success"} From 8299de15bafa6bd7b5fb329280ed2b6bf0d30cc1 Mon Sep 17 00:00:00 2001 From: Aseem Rastogi Date: Fri, 26 Apr 2024 10:36:54 +0000 Subject: [PATCH 107/239] fixing DSLs --- .../dsls/bool_refinement/BoolRefinement.fst | 13 +++++---- .../DependentBoolRefinement.fst | 13 +++++---- examples/dsls/stlc/STLC.Core.fst | 29 +++++++++++++++---- 3 files changed, 40 insertions(+), 15 deletions(-) diff --git a/examples/dsls/bool_refinement/BoolRefinement.fst b/examples/dsls/bool_refinement/BoolRefinement.fst index 8edbb0546f6..d384e2bda74 100755 --- a/examples/dsls/bool_refinement/BoolRefinement.fst +++ b/examples/dsls/bool_refinement/BoolRefinement.fst @@ -1685,12 +1685,15 @@ let soundness_lemma (f:RT.fstar_top_env) (fun dd -> FStar.Squash.return_squash (soundness dd)) let main (nm:string) (src:src_exp) : RT.dsl_tac_t = - fun f -> + fun (f, expected_t) -> if ln src && closed src - then - let (| src_ty, _ |) = check f [] src in - soundness_lemma f [] src src_ty; - [RT.mk_checked_let f nm (elab_exp src) (elab_ty src_ty)] + then if None? expected_t + then let (| src_ty, _ |) = check f [] src in + soundness_lemma f [] src src_ty; + [], + RT.mk_checked_let f (T.cur_module ()) nm (elab_exp src) (elab_ty src_ty), + [] + else T.fail "Bool refinement DSL: no support for expected type yet" else T.fail "Not locally nameless" (***** Examples *****) diff --git a/examples/dsls/dependent_bool_refinement/DependentBoolRefinement.fst b/examples/dsls/dependent_bool_refinement/DependentBoolRefinement.fst index 2eb14f17226..5fc26b2f452 100755 --- a/examples/dsls/dependent_bool_refinement/DependentBoolRefinement.fst +++ b/examples/dsls/dependent_bool_refinement/DependentBoolRefinement.fst @@ -878,10 +878,13 @@ and closed_ty (t:src_ty) let main (nm:string) (src:src_exp) : RT.dsl_tac_t - = fun f -> + = fun (f, expected_t) -> if closed src - then - let (| src_ty, _ |) = check f [] src in - soundness_lemma f [] src src_ty; - [RT.mk_checked_let f nm (elab_exp src) (elab_ty src_ty)] + then if None? expected_t + then let (| src_ty, _ |) = check f [] src in + soundness_lemma f [] src src_ty; + [], + RT.mk_checked_let f (T.cur_module ()) nm (elab_exp src) (elab_ty src_ty), + [] + else T.fail "Dependent bool refinement DSL: no support for expected type yet" else T.fail "Not locally nameless" diff --git a/examples/dsls/stlc/STLC.Core.fst b/examples/dsls/stlc/STLC.Core.fst index c8007d7c6c2..918f3087e00 100755 --- a/examples/dsls/stlc/STLC.Core.fst +++ b/examples/dsls/stlc/STLC.Core.fst @@ -1,3 +1,19 @@ +(* + Copyright 2023 Microsoft Research + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + module STLC.Core module T = FStar.Tactics.V2 module R = FStar.Reflection.V2 @@ -537,12 +553,15 @@ let soundness_lemma (sg:stlc_env) (fun dd -> FStar.Squash.return_squash (soundness dd g)) let main (nm:string) (src:stlc_exp) : RT.dsl_tac_t = - fun g -> + fun (g, expected_t) -> if ln src && closed src - then - let (| src_ty, d |) = check g [] src in - soundness_lemma [] src src_ty g; - [RT.mk_checked_let g nm (elab_exp src) (elab_ty src_ty)] + then if None? expected_t + then let (| src_ty, d |) = check g [] src in + soundness_lemma [] src src_ty g; + [], + RT.mk_checked_let g (T.cur_module ()) nm (elab_exp src) (elab_ty src_ty), + [] + else T.fail "STLC Core DSL: no support for expected type yet" else T.fail "Not locally nameless" (***** Tests *****) From a3bb2c03f05e23ed8369bb55279745eb78981fe6 Mon Sep 17 00:00:00 2001 From: Aseem Rastogi Date: Fri, 26 Apr 2024 10:56:34 +0000 Subject: [PATCH 108/239] one more --- examples/dsls/stlc/STLC.Infer.fst | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/examples/dsls/stlc/STLC.Infer.fst b/examples/dsls/stlc/STLC.Infer.fst index 4bc09510746..ba347619a1a 100755 --- a/examples/dsls/stlc/STLC.Infer.fst +++ b/examples/dsls/stlc/STLC.Infer.fst @@ -1,3 +1,19 @@ +(* + Copyright 2024 Microsoft Research + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + module STLC.Infer module T = FStar.Tactics.V2 module R = FStar.Reflection.V2 @@ -123,10 +139,10 @@ let rec elab_core g (e:stlc_exp R.term) let main (nm:string) (e:stlc_exp unit) : RT.dsl_tac_t - = fun g -> + = fun (g, expected_t) -> let (| e, _ |) = infer g [] e in let e = elab_core g e in - Core.main nm e g + Core.main nm e (g, expected_t) (***** Tests *****) From 7fe6f025d446dfe142a2191cc8f600fa4f52ff61 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 26 Apr 2024 11:55:30 -0700 Subject: [PATCH 109/239] Augment test --- tests/micro-benchmarks/DeltaDepthUnif.fst | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/tests/micro-benchmarks/DeltaDepthUnif.fst b/tests/micro-benchmarks/DeltaDepthUnif.fst index 6d1f49474f3..fd45b88c74a 100644 --- a/tests/micro-benchmarks/DeltaDepthUnif.fst +++ b/tests/micro-benchmarks/DeltaDepthUnif.fst @@ -4,6 +4,7 @@ module DeltaDepthUnif open FStar.Reflection.V2 open FStar.Reflection.Typing +open FStar.Mul assume val tyc : term -> Type0 @@ -21,3 +22,7 @@ let test1 = return_squash (magic ()) assume val f : p -> False val test2 : (~p) let test2 = return_squash f + +assume +val ty : int -> Type +let test3 (#n:nat) (x : ty 0) : ty (0 * n) = x From 11c104ca347395e5fcbe93beb197590e39f27b0c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 25 Apr 2024 20:18:30 -0700 Subject: [PATCH 110/239] Introduce tests/hacl/ with small snippets from HACL* --- tests/Makefile | 1 + tests/hacl/HaclTests.fst.config.json | 7 + tests/hacl/Lib.IntTypes.fsti | 988 +++++++++++++++++++++++++++ tests/hacl/Lib.LoopCombinators.fst | 205 ++++++ tests/hacl/Lib.LoopCombinators.fsti | 291 ++++++++ tests/hacl/Lib.Sequence.Lemmas.fst | 801 ++++++++++++++++++++++ tests/hacl/Lib.Sequence.Lemmas.fsti | 701 +++++++++++++++++++ tests/hacl/Lib.Sequence.fsti | 612 +++++++++++++++++ tests/hacl/Lib.Vec.Lemmas.fst | 741 ++++++++++++++++++++ tests/hacl/Lib.Vec.Lemmas.fsti | 331 +++++++++ tests/hacl/Makefile | 14 + 11 files changed, 4692 insertions(+) create mode 100644 tests/hacl/HaclTests.fst.config.json create mode 100644 tests/hacl/Lib.IntTypes.fsti create mode 100644 tests/hacl/Lib.LoopCombinators.fst create mode 100644 tests/hacl/Lib.LoopCombinators.fsti create mode 100644 tests/hacl/Lib.Sequence.Lemmas.fst create mode 100644 tests/hacl/Lib.Sequence.Lemmas.fsti create mode 100644 tests/hacl/Lib.Sequence.fsti create mode 100644 tests/hacl/Lib.Vec.Lemmas.fst create mode 100644 tests/hacl/Lib.Vec.Lemmas.fsti create mode 100644 tests/hacl/Makefile diff --git a/tests/Makefile b/tests/Makefile index ee282fcbe99..5bbeacd54d2 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -16,6 +16,7 @@ ALL_TEST_DIRS += struct ALL_TEST_DIRS += tactics ALL_TEST_DIRS += typeclasses ALL_TEST_DIRS += vale +ALL_TEST_DIRS += hacl HAS_OCAML := $(shell which ocamlfind 2>/dev/null) ifneq (,$(HAS_OCAML)) diff --git a/tests/hacl/HaclTests.fst.config.json b/tests/hacl/HaclTests.fst.config.json new file mode 100644 index 00000000000..6d6e73162ba --- /dev/null +++ b/tests/hacl/HaclTests.fst.config.json @@ -0,0 +1,7 @@ +{ + "fstar_exe": "fstar.exe", + "options": [ + ], + "include_dirs": [ + ] +} diff --git a/tests/hacl/Lib.IntTypes.fsti b/tests/hacl/Lib.IntTypes.fsti new file mode 100644 index 00000000000..6c7e3370f24 --- /dev/null +++ b/tests/hacl/Lib.IntTypes.fsti @@ -0,0 +1,988 @@ +module Lib.IntTypes + +open FStar.Mul + +#push-options "--max_fuel 0 --max_ifuel 1 --z3rlimit 20" + +// Other instances frollow from `FStar.UInt.pow2_values` which is in +// scope of every module depending on Lib.IntTypes +val pow2_2: n:nat -> Lemma (pow2 2 = 4) [SMTPat (pow2 n)] +val pow2_3: n:nat -> Lemma (pow2 3 = 8) [SMTPat (pow2 n)] +val pow2_4: n:nat -> Lemma (pow2 4 = 16) [SMTPat (pow2 n)] +val pow2_127: n:nat -> Lemma (pow2 127 = 0x80000000000000000000000000000000) [SMTPat (pow2 n)] + +/// +/// Definition of machine integer base types +/// + +type inttype = + | U1 | U8 | U16 | U32 | U64 | U128 | S8 | S16 | S32 | S64 | S128 + +[@(strict_on_arguments [0])] +unfold +inline_for_extraction +let unsigned = function + | U1 | U8 | U16 | U32 | U64 | U128 -> true + | _ -> false + +[@(strict_on_arguments [0])] +unfold +inline_for_extraction +let signed = function + | S8 | S16 | S32 | S64 | S128 -> true + | _ -> false + +/// +/// Operations on the underlying machine integer base types +/// + +[@(strict_on_arguments [0])] +unfold +inline_for_extraction +let numbytes = function + | U1 -> 1 + | U8 -> 1 + | S8 -> 1 + | U16 -> 2 + | S16 -> 2 + | U32 -> 4 + | S32 -> 4 + | U64 -> 8 + | S64 -> 8 + | U128 -> 16 + | S128 -> 16 + +[@(strict_on_arguments [0])] +unfold +inline_for_extraction +let bits = function + | U1 -> 1 + | U8 -> 8 + | S8 -> 8 + | U16 -> 16 + | S16 -> 16 + | U32 -> 32 + | S32 -> 32 + | U64 -> 64 + | S64 -> 64 + | U128 -> 128 + | S128 -> 128 + +val bits_numbytes: t:inttype{~(U1? t)} -> Lemma (bits t == 8 * numbytes t) +// [SMTPat [bits t; numbytes t]] + +unfold +let modulus (t:inttype) = pow2 (bits t) + +[@(strict_on_arguments [0])] +unfold +let maxint (t:inttype) = + if unsigned t then pow2 (bits t) - 1 else pow2 (bits t - 1) - 1 + +[@(strict_on_arguments [0])] +unfold +let minint (t:inttype) = + if unsigned t then 0 else -(pow2 (bits t - 1)) + +let range (n:int) (t:inttype) : Type0 = + minint t <= n /\ n <= maxint t + +unfold +type range_t (t:inttype) = x:int{range x t} + +/// +/// PUBLIC Machine Integers +/// + +inline_for_extraction +let pub_int_t = function + | U1 -> n:UInt8.t{UInt8.v n < 2} + | U8 -> UInt8.t + | U16 -> UInt16.t + | U32 -> UInt32.t + | U64 -> UInt64.t + | U128 -> UInt128.t + | S8 -> Int8.t + | S16 -> Int16.t + | S32 -> Int32.t + | S64 -> Int64.t + | S128 -> Int128.t + + +[@(strict_on_arguments [0])] +unfold +let pub_int_v #t (x:pub_int_t t) : range_t t = + match t with + | U1 -> UInt8.v x + | U8 -> UInt8.v x + | U16 -> UInt16.v x + | U32 -> UInt32.v x + | U64 -> UInt64.v x + | U128 -> UInt128.v x + | S8 -> Int8.v x + | S16 -> Int16.v x + | S32 -> Int32.v x + | S64 -> Int64.v x + | S128 -> Int128.v x + +/// +/// SECRET Machine Integers +/// + +type secrecy_level = + | SEC + | PUB + +inline_for_extraction +val sec_int_t: inttype -> Type0 + +val sec_int_v: #t:inttype -> sec_int_t t -> range_t t + +/// +/// GENERIC Machine Integers +/// + +inline_for_extraction +let int_t (t:inttype) (l:secrecy_level) = + match l with + | PUB -> pub_int_t t + | SEC -> sec_int_t t + +[@(strict_on_arguments [1])] +let v #t #l (u:int_t t l) : range_t t = + match l with + | PUB -> pub_int_v #t u + | SEC -> sec_int_v #t u + +unfold +let uint_t (t:inttype{unsigned t}) (l:secrecy_level) = int_t t l + +unfold +let sint_t (t:inttype{signed t}) (l:secrecy_level) = int_t t l + +unfold +let uint_v #t #l (u:uint_t t l) = v u + +unfold +let sint_v #t #l (u:sint_t t l) = v u + +unfold +type uint1 = uint_t U1 SEC + +unfold +type uint8 = uint_t U8 SEC + +unfold +type int8 = sint_t S8 SEC + +unfold +type uint16 = uint_t U16 SEC + +unfold +type int16 = sint_t S16 SEC + +unfold +type uint32 = uint_t U32 SEC + +unfold +type int32 = sint_t S32 SEC + +unfold +type uint64 = uint_t U64 SEC + +unfold +type int64 = sint_t S64 SEC + +unfold +type uint128 = uint_t U128 SEC + +unfold +type int128 = sint_t S128 SEC + +unfold +type bit_t = uint_t U1 PUB + +unfold +type byte_t = uint_t U8 PUB + +unfold +type size_t = uint_t U32 PUB + +// 2019.7.19: Used only by experimental Blake2b; remove? +unfold +type size128_t = uint_t U128 PUB + +unfold +type pub_uint8 = uint_t U8 PUB + +unfold +type pub_int8 = sint_t S8 PUB + +unfold +type pub_uint16 = uint_t U16 PUB + +unfold +type pub_int16 = sint_t S16 PUB + +unfold +type pub_uint32 = uint_t U32 PUB + +unfold +type pub_int32 = sint_t S32 PUB + +unfold +type pub_uint64 = uint_t U64 PUB + +unfold +type pub_int64 = sint_t S64 PUB + +unfold +type pub_uint128 = uint_t U128 PUB + +unfold +type pub_int128 = sint_t S128 PUB + +/// +/// Casts between mathematical and machine integers +/// + +inline_for_extraction +val secret: #t:inttype -> x:int_t t PUB -> y:int_t t SEC{v x == v y} + +[@(strict_on_arguments [0])] +inline_for_extraction +val mk_int: #t:inttype -> #l:secrecy_level -> n:range_t t -> u:int_t t l{v u == n} + +unfold +let uint (#t:inttype{unsigned t}) (#l:secrecy_level) (n:range_t t) = mk_int #t #l n + +unfold +let sint (#t:inttype{signed t}) (#l:secrecy_level) (n:range_t t) = mk_int #t #l n + +val v_injective: #t:inttype -> #l:secrecy_level -> a:int_t t l -> Lemma + (mk_int (v #t #l a) == a) + [SMTPat (v #t #l a)] + +val v_mk_int: #t:inttype -> #l:secrecy_level -> n:range_t t -> Lemma + (v #t #l (mk_int #t #l n) == n) + [SMTPat (v #t #l (mk_int #t #l n))] + +unfold +let u1 (n:range_t U1) : u:uint1{v u == n} = uint #U1 #SEC n + +unfold +let u8 (n:range_t U8) : u:uint8{v u == n} = uint #U8 #SEC n + +unfold +let i8 (n:range_t S8) : u:int8{v u == n} = sint #S8 #SEC n + +unfold +let u16 (n:range_t U16) : u:uint16{v u == n} = uint #U16 #SEC n + +unfold +let i16 (n:range_t S16) : u:int16{v u == n} = sint #S16 #SEC n + +unfold +let u32 (n:range_t U32) : u:uint32{v u == n} = uint #U32 #SEC n + +unfold +let i32 (n:range_t S32) : u:int32{v u == n} = sint #S32 #SEC n + +unfold +let u64 (n:range_t U64) : u:uint64{v u == n} = uint #U64 #SEC n + +unfold +let i64 (n:range_t S64) : u:int64{v u == n} = sint #S64 #SEC n + +(* We only support 64-bit literals, hence the unexpected upper limit *) +inline_for_extraction +val u128: n:range_t U64 -> u:uint128{v #U128 u == n} + +inline_for_extraction +val i128 (n:range_t S64) : u:int128{v #S128 u == n} + +unfold +let max_size_t = maxint U32 + +unfold +type size_nat = n:nat{n <= max_size_t} + +unfold +type size_pos = n:pos{n <= max_size_t} + +unfold +let size (n:size_nat) : size_t = uint #U32 #PUB n + +unfold +let size_v (s:size_t) = v s + +unfold +let byte (n:nat{n < 256}) : b:byte_t{v b == n} = uint #U8 #PUB n + +unfold +let byte_v (s:byte_t) : n:size_nat{v s == n} = v s + +inline_for_extraction +val size_to_uint32: s:size_t -> u:uint32{u == u32 (v s)} + +inline_for_extraction +val size_to_uint64: s:size_t -> u:uint64{u == u64 (v s)} + +inline_for_extraction +val byte_to_uint8: s:byte_t -> u:uint8{u == u8 (v s)} + +[@(strict_on_arguments [0])] +inline_for_extraction +let op_At_Percent_Dot x t = + if unsigned t then x % modulus t + else FStar.Int.(x @% modulus t) + +// Casting a value to a signed type is implementation-defined when the value can't +// be represented in the new type; e.g. (int8_t)128UL is implementation-defined +// We rule out this case in the type of `u1` +// See 6.3.1.3 in http://www.open-std.org/jtc1/sc22/wg14/www/docs/n1548.pdf +[@(strict_on_arguments [0;2])] +inline_for_extraction +val cast: #t:inttype -> #l:secrecy_level + -> t':inttype + -> l':secrecy_level{PUB? l \/ SEC? l'} + -> u1:int_t t l{unsigned t' \/ range (v u1) t'} + -> u2:int_t t' l'{v u2 == v u1 @%. t'} + +[@(strict_on_arguments [0])] +unfold +let to_u1 #t #l u : uint1 = cast #t #l U1 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_u8 #t #l u : uint8 = cast #t #l U8 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_i8 #t #l u : int8 = cast #t #l S8 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_u16 #t #l u : uint16 = cast #t #l U16 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_i16 #t #l u : int16 = cast #t #l S16 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_u32 #t #l u : uint32 = cast #t #l U32 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_i32 #t #l u : int32 = cast #t #l S32 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_u64 #t #l u : uint64 = cast #t #l U64 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_i64 #t #l u : int64 = cast #t #l S64 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_u128 #t #l u : uint128 = cast #t #l U128 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_i128 #t #l u : int128 = cast #t #l S128 SEC u + +/// +/// Bitwise operators for all machine integers +/// + +[@(strict_on_arguments [0])] +inline_for_extraction +let ones_v (t:inttype) = + match t with + | U1 | U8 | U16 | U32 | U64 | U128 -> maxint t + | S8 | S16 | S32 | S64 | S128 -> -1 + +[@(strict_on_arguments [0])] +inline_for_extraction +val ones: t:inttype -> l:secrecy_level -> n:int_t t l{v n = ones_v t} + +inline_for_extraction +val zeros: t:inttype -> l:secrecy_level -> n:int_t t l{v n = 0} + +[@(strict_on_arguments [0])] +inline_for_extraction +val add_mod: #t:inttype{unsigned t} -> #l:secrecy_level + -> int_t t l + -> int_t t l + -> int_t t l + +val add_mod_lemma: #t:inttype{unsigned t} -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l + -> Lemma + (v (add_mod a b) == (v a + v b) @%. t) + [SMTPat (v #t #l (add_mod #t #l a b))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val add: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l{range (v a + v b) t} + -> int_t t l + +val add_lemma: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l{range (v a + v b) t} + -> Lemma + (v #t #l (add #t #l a b) == v a + v b) + [SMTPat (v #t #l (add #t #l a b))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val incr: #t:inttype -> #l:secrecy_level + -> a:int_t t l{v a < maxint t} + -> int_t t l + +val incr_lemma: #t:inttype -> #l:secrecy_level + -> a:int_t t l{v a < maxint t} + -> Lemma (v (incr a) == v a + 1) + +[@(strict_on_arguments [0])] +inline_for_extraction +val mul_mod: #t:inttype{unsigned t /\ ~(U128? t)} -> #l:secrecy_level + -> int_t t l + -> int_t t l + -> int_t t l + +val mul_mod_lemma: #t:inttype{unsigned t /\ ~(U128? t)} -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l + -> Lemma (v (mul_mod a b) == (v a * v b) @%. t) + [SMTPat (v #t #l (mul_mod #t #l a b))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val mul: #t:inttype{~(U128? t) /\ ~(S128? t)} -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l{range (v a * v b) t} + -> int_t t l + +val mul_lemma: #t:inttype{~(U128? t) /\ ~(S128? t)} -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l{range (v a * v b) t} + -> Lemma (v #t #l (mul #t #l a b) == v a * v b) + [SMTPat (v #t #l (mul #t #l a b))] + +inline_for_extraction +val mul64_wide: uint64 -> uint64 -> uint128 + +val mul64_wide_lemma: a:uint64 -> b:uint64 -> Lemma + (v (mul64_wide a b) == v a * v b) + [SMTPat (v (mul64_wide a b))] +// KB: I'd prefer +// v (mul64_wide a b) = (pow2 (bits t) + v a - v b) % pow2 (bits t) + +inline_for_extraction +val mul_s64_wide: int64 -> int64 -> int128 + +val mul_s64_wide_lemma: a:int64 -> b:int64 -> Lemma + (v (mul_s64_wide a b) == v a * v b) + [SMTPat (v (mul_s64_wide a b))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val sub_mod: #t:inttype{unsigned t} -> #l:secrecy_level + -> int_t t l + -> int_t t l + -> int_t t l + +val sub_mod_lemma: #t:inttype{unsigned t} -> #l:secrecy_level -> a:int_t t l -> b:int_t t l + -> Lemma (v (sub_mod a b) == (v a - v b) @%. t) + [SMTPat (v #t #l (sub_mod #t #l a b))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val sub: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l{range (v a - v b) t} + -> int_t t l + +val sub_lemma: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l{range (v a - v b) t} + -> Lemma (v (sub a b) == v a - v b) + [SMTPat (v #t #l (sub #t #l a b))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val decr: #t:inttype -> #l:secrecy_level + -> a:int_t t l{minint t < v a} + -> int_t t l + +val decr_lemma: #t:inttype -> #l:secrecy_level + -> a:int_t t l{minint t < v a} + -> Lemma (v (decr a) == v a - 1) + +[@(strict_on_arguments [0])] +inline_for_extraction +val logxor: #t:inttype -> #l:secrecy_level + -> int_t t l + -> int_t t l + -> int_t t l + +val logxor_lemma: #t:inttype -> #l:secrecy_level -> a:int_t t l -> b:int_t t l -> Lemma + (a `logxor` (a `logxor` b) == b /\ + a `logxor` (b `logxor` a) == b /\ + a `logxor` (mk_int #t #l 0) == a) + +val logxor_lemma1: #t:inttype -> #l:secrecy_level -> a:int_t t l -> b:int_t t l -> Lemma + (requires range (v a) U1 /\ range (v b) U1) + (ensures range (v (a `logxor` b)) U1) + +let logxor_v (#t:inttype) (a:range_t t) (b:range_t t) : range_t t = + match t with + | S8 | S16 | S32 | S64 | S128 -> Int.logxor #(bits t) a b + | _ -> UInt.logxor #(bits t) a b + +val logxor_spec: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l + -> Lemma (v (a `logxor` b) == v a `logxor_v` v b) + +[@(strict_on_arguments [0])] +inline_for_extraction +val logand: #t:inttype -> #l:secrecy_level + -> int_t t l + -> int_t t l + -> int_t t l + +val logand_zeros: #t:inttype -> #l:secrecy_level -> a:int_t t l -> + Lemma (v (a `logand` zeros t l) == 0) + +val logand_ones: #t:inttype -> #l:secrecy_level -> a:int_t t l -> + Lemma (v (a `logand` ones t l) == v a) + +// For backwards compatibility +val logand_lemma: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l + -> Lemma + (requires v a = 0 \/ v a = ones_v t) + (ensures (if v a = 0 then v (a `logand` b) == 0 else v (a `logand` b) == v b)) + +let logand_v (#t:inttype) (a:range_t t) (b:range_t t) : range_t t = + match t with + | S8 | S16 | S32 | S64 | S128 -> Int.logand #(bits t) a b + | _ -> UInt.logand #(bits t) a b + +val logand_spec: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l + -> Lemma (v (a `logand` b) == v a `logand_v` v b) + //[SMTPat (v (a `logand` b))] + +val logand_le:#t:inttype{unsigned t} -> #l:secrecy_level -> a:uint_t t l -> b:uint_t t l -> + Lemma (requires True) + (ensures v (logand a b) <= v a /\ v (logand a b) <= v b) + +val logand_mask: #t:inttype{unsigned t} -> #l:secrecy_level -> a:uint_t t l -> b:uint_t t l -> m:pos{m < bits t} -> + Lemma + (requires v b == pow2 m - 1) + (ensures v (logand #t #l a b) == v a % pow2 m) + +[@(strict_on_arguments [0])] +inline_for_extraction +val logor: #t:inttype -> #l:secrecy_level + -> int_t t l + -> int_t t l + -> int_t t l + +val logor_disjoint: #t:inttype{unsigned t} -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l + -> m:nat{m < bits t} + -> Lemma + (requires 0 <= v a /\ v a < pow2 m /\ v b % pow2 m == 0) + (ensures v (a `logor` b) == v a + v b) + //[SMTPat (v (a `logor` b))] + +val logor_zeros: #t: inttype -> #l: secrecy_level -> a: int_t t l -> + Lemma (v (a `logor` zeros t l) == v a) + +val logor_ones: #t: inttype -> #l: secrecy_level -> a: int_t t l -> + Lemma (v (a `logor` ones t l) == ones_v t) + +// For backwards compatibility +val logor_lemma: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l + -> Lemma + (requires v a = 0 \/ v a = ones_v t) + (ensures (if v a = ones_v t then v (a `logor` b) == ones_v t else v (a `logor` b) == v b)) + +let logor_v (#t:inttype) (a:range_t t) (b:range_t t) : range_t t = + match t with + | S8 | S16 | S32 | S64 | S128 -> Int.logor #(bits t) a b + | _ -> UInt.logor #(bits t) a b + +val logor_spec: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l + -> Lemma (v (a `logor` b) == v a `logor_v` v b) + + +[@(strict_on_arguments [0])] +inline_for_extraction +val lognot: #t:inttype -> #l:secrecy_level -> int_t t l -> int_t t l + +val lognot_lemma: #t: inttype -> #l: secrecy_level -> + a: int_t t l -> + Lemma + (requires v a = 0 \/ v a = ones_v t) + (ensures (if v a = ones_v t then v (lognot a) == 0 else v (lognot a) == ones_v t)) + +let lognot_v (#t:inttype) (a:range_t t) : range_t t = + match t with + | S8 | S16 | S32 | S64 | S128 -> Int.lognot #(bits t) a + | _ -> UInt.lognot #(bits t) a + +val lognot_spec: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> Lemma (v (lognot a) == lognot_v (v a)) + +inline_for_extraction +type shiftval (t:inttype) = u:size_t{v u < bits t} + +inline_for_extraction +type rotval (t:inttype) = u:size_t{0 < v u /\ v u < bits t} + +[@(strict_on_arguments [0])] +inline_for_extraction +val shift_right: #t:inttype -> #l:secrecy_level + -> int_t t l + -> shiftval t + -> int_t t l + +val shift_right_lemma: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:shiftval t + -> Lemma + (v (shift_right a b) == v a / pow2 (v b)) + [SMTPat (v #t #l (shift_right #t #l a b))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val shift_left: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> s:shiftval t + -> Pure (int_t t l) + (requires unsigned t \/ (0 <= v a /\ v a * pow2 (v s) <= maxint t)) + (ensures fun _ -> True) + +val shift_left_lemma: + #t:inttype + -> #l:secrecy_level + -> a:int_t t l{unsigned t \/ 0 <= v a} + -> s:shiftval t{unsigned t \/ (0 <= v a /\ v a * pow2 (v s) <= maxint t)} + -> Lemma + (v (shift_left a s) == (v a * pow2 (v s)) @%. t) + [SMTPat (v #t #l (shift_left #t #l a s))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val rotate_right: #t:inttype -> #l:secrecy_level + -> a:int_t t l{unsigned t} + -> rotval t + -> int_t t l + +[@(strict_on_arguments [0])] +inline_for_extraction +val rotate_left: #t:inttype -> #l:secrecy_level + -> a:int_t t l{unsigned t} + -> rotval t + -> int_t t l + +inline_for_extraction +let shift_right_i (#t:inttype) (#l:secrecy_level) (s:shiftval t{unsigned t}) (u:uint_t t l) : uint_t t l = shift_right u s + +inline_for_extraction +let shift_left_i (#t:inttype) (#l:secrecy_level) (s:shiftval t{unsigned t}) (u:uint_t t l) : uint_t t l = shift_left u s + +inline_for_extraction +let rotate_right_i (#t:inttype) (#l:secrecy_level) (s:rotval t{unsigned t}) (u:uint_t t l) : uint_t t l = rotate_right u s + +inline_for_extraction +let rotate_left_i (#t:inttype) (#l:secrecy_level) (s:rotval t{unsigned t}) (u:uint_t t l) : uint_t t l = rotate_left u s + + +[@(strict_on_arguments [0])] +inline_for_extraction +val ct_abs: #t:inttype{signed t /\ ~(S128? t)} -> #l:secrecy_level + -> a:int_t t l{minint t < v a} + -> b:int_t t l{v b == abs (v a)} + +/// +/// Masking operators for all machine integers +/// + +[@(strict_on_arguments [0])] +inline_for_extraction +val eq_mask: #t:inttype{~(S128? t)} -> int_t t SEC -> int_t t SEC -> int_t t SEC + +val eq_mask_lemma: #t:inttype{~(S128? t)} -> a:int_t t SEC -> b:int_t t SEC -> Lemma + (if v a = v b then v (eq_mask a b) == ones_v t + else v (eq_mask a b) == 0) + [SMTPat (eq_mask #t a b)] + +val eq_mask_logand_lemma: + #t:inttype{~(S128? t)} + -> a:int_t t SEC + -> b:int_t t SEC + -> c:int_t t SEC -> Lemma + (if v a = v b then v (c `logand` eq_mask a b) == v c + else v (c `logand` eq_mask a b) == 0) + [SMTPat (c `logand` eq_mask a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val neq_mask: #t:inttype{~(S128? t)} -> a:int_t t SEC -> b:int_t t SEC -> int_t t SEC + +val neq_mask_lemma: #t:inttype{~(S128? t)} -> a:int_t t SEC -> b:int_t t SEC -> Lemma + (if v a = v b then v (neq_mask a b) == 0 + else v (neq_mask a b) == ones_v t) + [SMTPat (neq_mask #t a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val gte_mask: #t:inttype{unsigned t} -> int_t t SEC -> b:int_t t SEC -> int_t t SEC + +val gte_mask_lemma: #t:inttype{unsigned t} -> a:int_t t SEC -> b:int_t t SEC -> Lemma + (if v a >= v b then v (gte_mask a b) == ones_v t + else v (gte_mask a b) == 0) + [SMTPat (gte_mask #t a b)] + +val gte_mask_logand_lemma: #t:inttype{unsigned t} + -> a:int_t t SEC + -> b:int_t t SEC + -> c:int_t t SEC + -> Lemma + (if v a >= v b then v (c `logand` gte_mask a b) == v c + else v (c `logand` gte_mask a b) == 0) + [SMTPat (c `logand` gte_mask a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val lt_mask: #t:inttype{unsigned t} -> int_t t SEC -> int_t t SEC -> int_t t SEC + +val lt_mask_lemma: #t:inttype{unsigned t} -> a:int_t t SEC -> b:int_t t SEC -> Lemma + (if v a < v b then v (lt_mask a b) == ones_v t + else v (lt_mask a b) == 0) + [SMTPat (lt_mask #t a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val gt_mask: #t:inttype{unsigned t} -> int_t t SEC -> b:int_t t SEC -> int_t t SEC + +val gt_mask_lemma: #t:inttype{unsigned t} -> a:int_t t SEC -> b:int_t t SEC -> Lemma + (if v a > v b then v (gt_mask a b) == ones_v t + else v (gt_mask a b) == 0) + [SMTPat (gt_mask #t a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val lte_mask: #t:inttype{unsigned t} -> int_t t SEC -> int_t t SEC -> int_t t SEC + +val lte_mask_lemma: #t:inttype{unsigned t} -> a:int_t t SEC -> b:int_t t SEC -> Lemma + (if v a <= v b then v (lte_mask a b) == ones_v t + else v (lte_mask a b) == 0) + [SMTPat (lte_mask #t a b)] + +#push-options "--max_fuel 1" + +[@(strict_on_arguments [0])] +inline_for_extraction +let mod_mask (#t:inttype) (#l:secrecy_level) (m:shiftval t{pow2 (uint_v m) <= maxint t}) : int_t t l = + shift_left_lemma #t #l (mk_int 1) m; + (mk_int 1 `shift_left` m) `sub` mk_int 1 + +#pop-options + +val mod_mask_lemma: #t:inttype -> #l:secrecy_level + -> a:int_t t l -> m:shiftval t{pow2 (uint_v m) <= maxint t} + -> Lemma (v (a `logand` mod_mask m) == v a % pow2 (v m)) + [SMTPat (a `logand` mod_mask #t m)] + +(** Casts a value between two signed types using modular reduction *) +[@(strict_on_arguments [0;2])] +inline_for_extraction +val cast_mod: #t:inttype{signed t} -> #l:secrecy_level + -> t':inttype{signed t'} + -> l':secrecy_level{PUB? l \/ SEC? l'} + -> a:int_t t l + -> b:int_t t' l'{v b == v a @%. t'} + +/// +/// Operators available for all machine integers +/// + +unfold +let (+!) #t #l = add #t #l + +unfold +let (+.) #t #l = add_mod #t #l + +unfold +let ( *! ) #t #l = mul #t #l + +unfold +let ( *. ) #t #l = mul_mod #t #l + +unfold +let ( -! ) #t #l = sub #t #l + +unfold +let ( -. ) #t #l = sub_mod #t #l + +unfold +let ( >>. ) #t #l = shift_right #t #l + +unfold +let ( <<. ) #t #l = shift_left #t #l + +unfold +let ( >>>. ) #t #l = rotate_right #t #l + +unfold +let ( <<<. ) #t #l = rotate_left #t #l + +unfold +let ( ^. ) #t #l = logxor #t #l + +unfold +let ( |. ) #t #l = logor #t #l + +unfold +let ( &. ) #t #l = logand #t #l + +unfold +let ( ~. ) #t #l = lognot #t #l + +/// +/// Operations on public integers +/// + +[@(strict_on_arguments [0])] +inline_for_extraction +val div: #t:inttype{~(U128? t) /\ ~(S128? t)} + -> a:int_t t PUB + -> b:int_t t PUB{v b <> 0 /\ (unsigned t \/ range FStar.Int.(v a / v b) t)} + -> int_t t PUB + +val div_lemma: #t:inttype{~(U128? t) /\ ~(S128? t)} + -> a:int_t t PUB + -> b:int_t t PUB{v b <> 0 /\ (unsigned t \/ range FStar.Int.(v a / v b) t)} + -> Lemma (v (div a b) == FStar.Int.(v a / v b)) + [SMTPat (v #t (div #t a b))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val mod: #t:inttype{~(U128? t) /\ ~(S128? t)} + -> a:int_t t PUB + -> b:int_t t PUB{v b <> 0 /\ (unsigned t \/ range FStar.Int.(v a / v b) t)} + -> int_t t PUB + +val mod_lemma: #t:inttype{~(U128? t) /\ ~(S128? t)} + -> a:int_t t PUB + -> b:int_t t PUB{v b <> 0 /\ (unsigned t \/ range FStar.Int.(v a / v b) t)} + -> Lemma (if signed t then + v (mod a b) == FStar.Int.mod #(bits t) (v a) (v b) + else + v (mod a b) == FStar.UInt.mod #(bits t) (v a) (v b)) + [SMTPat (v #t (mod #t a b))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val eq: #t:inttype -> int_t t PUB -> int_t t PUB -> bool + +inline_for_extraction +val eq_lemma: #t:inttype + -> a:int_t t PUB + -> b:int_t t PUB + -> Lemma (a `eq` b == (v a = v b)) + [SMTPat (eq #t a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val ne: #t:inttype -> int_t t PUB -> int_t t PUB -> bool + +val ne_lemma: #t:inttype + -> a:int_t t PUB + -> b:int_t t PUB + -> Lemma (a `ne` b == (v a <> v b)) + [SMTPat (ne #t a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val lt: #t:inttype -> int_t t PUB -> int_t t PUB -> bool + +val lt_lemma: #t:inttype + -> a:int_t t PUB + -> b:int_t t PUB + -> Lemma (a `lt` b == (v a < v b)) + [SMTPat (lt #t a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val lte: #t:inttype -> int_t t PUB -> int_t t PUB -> bool + +val lte_lemma: #t:inttype + -> a:int_t t PUB + -> b:int_t t PUB + -> Lemma (a `lte` b == (v a <= v b)) + [SMTPat (lte #t a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val gt: #t:inttype -> int_t t PUB -> int_t t PUB -> bool + +val gt_lemma: #t:inttype + -> a:int_t t PUB + -> b:int_t t PUB + -> Lemma (a `gt` b == (v a > v b)) + [SMTPat (gt #t a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val gte: #t:inttype -> int_t t PUB -> int_t t PUB -> bool + +val gte_lemma: #t:inttype + -> a:int_t t PUB + -> b:int_t t PUB + -> Lemma (a `gte` b == (v a >= v b)) + [SMTPat (gte #t a b)] + +unfold +let (/.) #t = div #t + +unfold +let (%.) #t = mod #t + +unfold +let (=.) #t = eq #t + +unfold +let (<>.) #t = ne #t + +unfold +let (<.) #t = lt #t + +unfold +let (<=.) #t = lte #t + +unfold +let (>.) #t = gt #t + +unfold +let (>=.) #t = gte #t diff --git a/tests/hacl/Lib.LoopCombinators.fst b/tests/hacl/Lib.LoopCombinators.fst new file mode 100644 index 00000000000..38b2fe6e1b1 --- /dev/null +++ b/tests/hacl/Lib.LoopCombinators.fst @@ -0,0 +1,205 @@ +module Lib.LoopCombinators + +let rec repeat_left lo hi a f acc = + if lo = hi then acc + else repeat_left (lo + 1) hi a f (f lo acc) + +let rec repeat_left_all_ml lo hi a f acc = + if lo = hi then acc + else repeat_left_all_ml (lo + 1) hi a f (f lo acc) + +let rec repeat_right lo hi a f acc = + if lo = hi then acc + else f (hi - 1) (repeat_right lo (hi - 1) a f acc) + +let rec repeat_right_all_ml lo hi a f acc = + if lo = hi then acc + else f (hi - 1) (repeat_right_all_ml lo (hi - 1) a f acc) + +let rec repeat_right_plus lo mi hi a f acc = + if hi = mi then () + else repeat_right_plus lo mi (hi - 1) a f acc + +let unfold_repeat_right lo hi a f acc0 i = () + +let eq_repeat_right lo hi a f acc0 = () + +let rec repeat_left_right lo hi a f acc = + if lo = hi then () + else + begin + repeat_right_plus lo (lo + 1) hi a f acc; + repeat_left_right (lo + 1) hi a f (f lo acc) + end + +let repeat_gen n a f acc0 = + repeat_right 0 n a f acc0 + +let repeat_gen_all_ml n a f acc0 = + repeat_right_all_ml 0 n a f acc0 + +let unfold_repeat_gen n a f acc0 i = () +(* // Proof when using [repeat_left]: + repeat_left_right 0 (i + 1) a f acc0; + repeat_left_right 0 i a f acc0 +*) + +let eq_repeat_gen0 n a f acc0 = () + +let repeat_gen_def n a f acc0 = () + +let repeati #a n f acc0 = + repeat_gen n (fixed_a a) f acc0 + +let repeati_all_ml #a n f acc0 = + repeat_gen_all_ml n (fixed_a a) f acc0 + +let eq_repeati0 #a n f acc0 = () + +let unfold_repeati #a n f acc0 i = + unfold_repeat_gen n (fixed_a a) f acc0 i + +let repeati_def #a n f acc0 = () + +let repeat #a n f acc0 = + repeati n (fixed_i f) acc0 + +let eq_repeat0 #a f acc0 = () + +let unfold_repeat #a n f acc0 i = + unfold_repeati #a n (fixed_i f) acc0 i + + +let repeat_range #a min max f x = + repeat_left min max (fun _ -> a) f x + +let repeat_range_all_ml #a min max f x = + repeat_left_all_ml min max (fun _ -> a) f x + +let repeat_range_inductive #a min max pred f x = + repeat_left min max (fun i -> x:a{pred i x}) f x + +let repeati_inductive #a n pred f x0 = + repeat_range_inductive #a 0 n pred f x0 + +let unfold_repeat_right_once + (lo:nat) + (hi:nat{lo < hi}) + (a:(i:nat{lo <= i /\ i <= hi} -> Type)) + (f:(i:nat{lo <= i /\ i < hi} -> a i -> a (i + 1))) + (acc:a lo) + : Lemma (repeat_right lo hi a f acc == + f (hi - 1) (repeat_right lo (hi - 1) a f acc)) + = () + +module T = FStar.Tactics + +let refine_eq (a:Type) (p q:a -> prop) (x:squash (forall (i:a). p i <==> q i)) + : Lemma ((i:a{p i} == i:a{q i})) + = let pext (a:Type) (p q: a -> prop) (_:squash (forall (x:a). p x <==> q x)) (x:a) : Lemma (p x == q x) + = FStar.PropositionalExtensionality.apply (p x) (q x) + in + assert (i:a{p i} == i:a{q i}) + by (T.l_to_r [quote (pext a p q x)]; T.trefl()) + +let nat_refine_equiv (n:nat) + : Lemma ((i:nat{i <= n}) == (i:nat{0<=i /\ i<=n})) + = let b2t_prop (b:bool) + : Lemma ((b2t b) `subtype_of` unit) + = assert_norm (b2t b == squash (equals b true)) + in + refine_eq nat (fun (i:nat) -> b2t_prop (i <= n); b2t (i <= n)) (fun (i:nat) -> 0 <= i /\ i <= n) () + +let a' (#a:Type) (n:nat) (pred:(i:nat{i <= n} -> a -> Type)) = fun (i:nat{i<=n}) -> x:a{pred i x} + +let repeati_repeat_left_rewrite_type (#a:Type) (n:nat) (pred:(i:nat{i <= n} -> a -> Type)) + (f:repeatable #a #n pred) + (x0:a{pred 0 x0}) + : Lemma (repeati_inductive n pred f x0 == + repeat_left 0 n (a' n pred) f x0) + = assert (repeati_inductive n pred f x0 == + repeat_left 0 n (a' n pred) f x0) + by (T.norm [delta_only [`%repeati_inductive; + `%repeat_range_inductive; + `%a']]; + T.l_to_r [`nat_refine_equiv]; + T.trefl()) + +(* This proof is technical, for multiple reasons. + + 1. It requires an extensionality lemma at the level to types to + relate the type of a dependent function and an eta expansion of + that type + + 2. It requires an extensionality lemma at the level of the + computation, which also introduces an eta expansion on f to + retype it + + 3. The retyping introduces a function type at a different by + propositional equal domain, so it requires a use of rewriting + based on propositional extensionality to prove that the retyping + is benign + + The proof was simpler earlier, when F* had eta + equivalence. But the use of eta reduction in the SMT encoding which + this was relying on was a bit dodgy. In particular, the eta + reduction hid the retyping and so was silently (and + unintentionally) also enabling the use of propositional + extensionality. Now, that has to be explicit. +*) +let repeati_inductive_repeat_gen #a n pred f x0 = + let eta_a n (a:(i:nat{0 <= i /\ i <= n} -> Type)) = fun i -> a i in + let eta_f (f:repeatable #a #n pred) (i:nat{i < n}) (x:a' n pred i) : a' n pred (i + 1) = f i x in + let rec repeat_right_eta + (n:nat) + (hi:nat{hi <= n}) + (a:(i:nat{0 <= i /\ i <= n} -> Type)) + (f:(i:nat{0 <= i /\ i < n} -> a i -> a (i + 1))) + (acc:a 0) + : Lemma (ensures repeat_right 0 hi a f acc == repeat_right 0 hi (eta_a n a) f acc) + (decreases hi) + = if hi = 0 + then () + else (repeat_right_eta n (hi - 1) a f acc) + in + repeat_right_eta n n (a' n pred) (eta_f f) x0; + assert (repeat_gen n (fun i -> x:a{pred i x}) f x0 == + repeat_right 0 n (fun (i:nat{i <= n}) -> x:a{pred i x}) f x0) + by (T.norm [delta_only [`%repeat_gen]]; + T.trefl()); + assert_norm (a' n pred == (fun (i:nat{i <= n}) -> x:a{pred i x})); + assert (repeat_right 0 n (fun (i:nat{i <= n}) -> x:a{pred i x}) f x0 == + repeat_right 0 n (a' n pred) f x0); + let rec repeat_right_eta_f + (hi:nat{hi <= n}) + (acc:a' n pred 0) + : Lemma (ensures repeat_right 0 hi (a' n pred) f acc == + repeat_right 0 hi (a' n pred) (eta_f f) acc) + (decreases hi) + = if hi = 0 + then () + else (repeat_right_eta_f (hi - 1) acc) + in + repeati_repeat_left_rewrite_type n pred f x0; + assert (repeati_inductive n pred f x0 == + repeat_left 0 n (a' n pred) f x0); + repeat_left_right 0 n (a' n pred) f x0; + assert (repeat_left 0 n (a' n pred) f x0 == + repeat_right 0 n (a' n pred) f x0); + repeat_right_eta_f n x0 + + +let repeat_gen_inductive n a pred f x0 = + let f' (i:nat{i < n}) + (x:a i{pred i x /\ x == repeat_gen i a f x0}) + : x':a (i + 1){pred (i + 1) x' /\ x' == repeat_gen (i + 1) a f x0} + = f i x in + repeat_gen n (fun i -> x:a i{pred i x /\ x == repeat_gen i a f x0}) f' x0 + +let repeati_inductive' #a n pred f x0 = + let f' + (i:nat{i < n}) + (x:a{pred i x /\ x == repeati i f x0}) + : x':a{pred (i + 1) x' /\ x' == repeati (i + 1) f x0} + = f i x in + repeat_gen n (fun i -> x:a{pred i x /\ x == repeati i f x0}) f' x0 diff --git a/tests/hacl/Lib.LoopCombinators.fsti b/tests/hacl/Lib.LoopCombinators.fsti new file mode 100644 index 00000000000..c82d45b79c4 --- /dev/null +++ b/tests/hacl/Lib.LoopCombinators.fsti @@ -0,0 +1,291 @@ +module Lib.LoopCombinators + +(** +* fold_left-like loop combinator: +* [ repeat_left lo hi a f acc == f (hi - 1) .. ... (f (lo + 1) (f lo acc)) ] +* +* e.g. [ repeat_left 0 3 (fun _ -> list int) Cons [] == [2;1;0] ] +* +* It satisfies +* [ repeat_left lo hi (fun _ -> a) f acc == fold_left (flip f) acc [lo..hi-1] ] +* +* A simpler variant with a non-dependent accumuator used to be called [repeat_range] +*) + +val repeat_left: + lo:nat + -> hi:nat{lo <= hi} + -> a:(i:nat{lo <= i /\ i <= hi} -> Type) + -> f:(i:nat{lo <= i /\ i < hi} -> a i -> a (i + 1)) + -> acc:a lo + -> Tot (a hi) (decreases (hi - lo)) + + +val repeat_left_all_ml: + lo:nat + -> hi:nat{lo <= hi} + -> a:(i:nat{lo <= i /\ i <= hi} -> Type) + -> f:(i:nat{lo <= i /\ i < hi} -> a i -> FStar.All.ML (a (i + 1))) + -> acc:a lo + -> FStar.All.ML (a hi) + +(** +* fold_right-like loop combinator: +* [ repeat_right lo hi a f acc == f (hi - 1) .. ... (f (lo + 1) (f lo acc)) ] +* +* e.g. [ repeat_right 0 3 (fun _ -> list int) Cons [] == [2;1;0] ] +* +* It satisfies +* [ repeat_right lo hi (fun _ -> a) f acc == fold_right f acc [hi-1..lo] ] +*) +val repeat_right: + lo:nat + -> hi:nat{lo <= hi} + -> a:(i:nat{lo <= i /\ i <= hi} -> Type) + -> f:(i:nat{lo <= i /\ i < hi} -> a i -> a (i + 1)) + -> acc:a lo + -> Tot (a hi) (decreases (hi - lo)) + +val repeat_right_all_ml: + lo:nat + -> hi:nat{lo <= hi} + -> a:(i:nat{lo <= i /\ i <= hi} -> Type) + -> f:(i:nat{lo <= i /\ i < hi} -> a i -> FStar.All.ML (a (i + 1))) + -> acc:a lo + -> FStar.All.ML (a hi) (decreases (hi - lo)) + +(** Splitting a repetition *) +val repeat_right_plus: + lo:nat + -> mi:nat{lo <= mi} + -> hi:nat{mi <= hi} + -> a:(i:nat{lo <= i /\ i <= hi} -> Type) + -> f:(i:nat{lo <= i /\ i < hi} -> a i -> a (i + 1)) + -> acc:a lo + -> Lemma (ensures + repeat_right lo hi a f acc == + repeat_right mi hi a f (repeat_right lo mi a f acc)) + (decreases hi) + +(** Unfolding one iteration *) +val unfold_repeat_right: + lo:nat + -> hi:nat{lo <= hi} + -> a:(i:nat{lo <= i /\ i <= hi} -> Type) + -> f:(i:nat{lo <= i /\ i < hi} -> a i -> a (i + 1)) + -> acc0:a lo + -> i:nat{lo <= i /\ i < hi} + -> Lemma ( + repeat_right lo (i + 1) a f acc0 == + f i (repeat_right lo i a f acc0)) + +val eq_repeat_right: + lo:nat + -> hi:nat{lo <= hi} + -> a:(i:nat{lo <= i /\ i <= hi} -> Type) + -> f:(i:nat{lo <= i /\ i < hi} -> a i -> a (i + 1)) + -> acc0:a lo + -> Lemma (repeat_right lo lo a f acc0 == acc0) + +(** +* [repeat_left] and [repeat_right] are equivalent. +* +* This follows from the third duality theorem +* [ fold_right f acc xs = fold_left (flip f) acc (reverse xs) ] +*) +val repeat_left_right: + lo:nat + -> hi:nat{lo <= hi} + -> a:(i:nat{lo <= i /\ i <= hi} -> Type) + -> f:(i:nat{lo <= i /\ i < hi} -> a i -> a (i + 1)) + -> acc:a lo + -> Lemma (ensures repeat_right lo hi a f acc == repeat_left lo hi a f acc) + (decreases (hi - lo)) + +(** +* Repetition starting from 0 +* +* Defined as [repeat_right] for convenience, but [repeat_left] may be more +* efficient when extracted to OCaml. +*) + +val repeat_gen: + n:nat + -> a:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < n} -> a i -> a (i + 1)) + -> acc0:a 0 + -> a n + +val repeat_gen_all_ml: + n:nat + -> a:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < n} -> a i -> FStar.All.ML (a (i + 1))) + -> acc0:a 0 + -> FStar.All.ML (a n) + +(** Unfolding one iteration *) +val unfold_repeat_gen: + n:nat + -> a:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < n} -> a i -> a (i + 1)) + -> acc0:a 0 + -> i:nat{i < n} + -> Lemma (repeat_gen (i + 1) a f acc0 == f i (repeat_gen i a f acc0)) + +val eq_repeat_gen0: + n:nat + -> a:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < n} -> a i -> a (i + 1)) + -> acc0:a 0 + -> Lemma (repeat_gen 0 a f acc0 == acc0) + +val repeat_gen_def: + n:nat + -> a:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < n} -> a i -> a (i + 1)) + -> acc0:a 0 + -> Lemma (repeat_gen n a f acc0 == repeat_right 0 n a f acc0) + + +(** +* Repetition with a fixed accumulator type +*) + +let fixed_a (a:Type) (i:nat) = a + +let fixed_i f (i:nat) = f + +val repeati: + #a:Type + -> n:nat + -> f:(i:nat{i < n} -> a -> a) + -> acc0:a + -> a + +val repeati_all_ml: + #a:Type + -> n:nat + -> f:(i:nat{i < n} -> a -> FStar.All.ML a) + -> acc0:a + -> FStar.All.ML a + +val eq_repeati0: + #a:Type + -> n:nat + -> f:(i:nat{i < n} -> a -> a) + -> acc0:a + -> Lemma (repeati #a 0 f acc0 == acc0) + +(** Unfolding one iteration *) +val unfold_repeati: + #a:Type + -> n:nat + -> f:(i:nat{i < n} -> a -> a) + -> acc0:a + -> i:nat{i < n} + -> Lemma (repeati #a (i + 1) f acc0 == f i (repeati #a i f acc0)) + +val repeati_def: + #a:Type + -> n:nat + -> f:(i:nat{i < n} -> a -> a) + -> acc:a + -> Lemma (repeati n f acc == repeat_right 0 n (fixed_a a) f acc) + +val repeat: + #a:Type + -> n:nat + -> f:(a -> a) + -> acc0:a + -> a + +val eq_repeat0: + #a:Type + -> f:(a -> a) + -> acc0:a + -> Lemma (repeat #a 0 f acc0 == acc0) + +val unfold_repeat: + #a:Type + -> n:nat + -> f:(a -> a) + -> acc0:a + -> i:nat{i < n} + -> Lemma (repeat #a (i + 1) f acc0 == f (repeat #a i f acc0)) + +val repeat_range: + #a:Type + -> min:nat + -> max:nat{min <= max} + -> (s:nat{s >= min /\ s < max} -> a -> Tot a) + -> a + -> Tot a (decreases (max - min)) + +val repeat_range_all_ml: + #a:Type + -> min:nat + -> max:nat{min <= max} + -> (s:nat{s >= min /\ s < max} -> a -> FStar.All.ML a) + -> a + -> FStar.All.ML a + +unfold +type repeatable (#a:Type) (#n:nat) (pred:(i:nat{i <= n} -> a -> Tot Type)) = + i:nat{i < n} -> x:a{pred i x} -> y:a{pred (i+1) y} + +val repeat_range_inductive: + #a:Type + -> min:nat + -> max:nat{min <= max} + -> pred:(i:nat{i <= max} -> a -> Type) + -> f:repeatable #a #max pred + -> x0:a{pred min x0} + -> Tot (res:a{pred max res}) (decreases (max - min)) + +val repeati_inductive: + #a:Type + -> n:nat + -> pred:(i:nat{i <= n} -> a -> Type) + -> f:repeatable #a #n pred + -> x0:a{pred 0 x0} + -> res:a{pred n res} + +val repeati_inductive_repeat_gen: + #a:Type + -> n:nat + -> pred:(i:nat{i <= n} -> a -> Type) + -> f:repeatable #a #n pred + -> x0:a{pred 0 x0} + -> Lemma (repeati_inductive n pred f x0 == repeat_gen n (fun i -> x:a{pred i x}) f x0) + +type preserves_predicate (n:nat) + (a:(i:nat{i <= n} -> Type)) + (f:(i:nat{i < n} -> a i -> a (i + 1))) + (pred:(i:nat{i <= n} -> a i -> Tot Type))= + forall (i:nat{i < n}) (x:a i). pred i x ==> pred (i + 1) (f i x) + +val repeat_gen_inductive: + n:nat + -> a:(i:nat{i <= n} -> Type) + -> pred:(i:nat{i <= n} -> a i -> Type0) + -> f:(i:nat{i < n} -> a i -> a (i + 1)) + -> x0:a 0 + -> Pure (a n) + (requires preserves_predicate n a f pred /\ pred 0 x0) + (ensures fun res -> pred n res /\ res == repeat_gen n a f x0) + +type preserves (#a:Type) + (#n:nat) + (f:(i:nat{i < n} -> a -> a)) + (pred:(i:nat{i <= n} -> a -> Tot Type)) = + forall (i:nat{i < n}) (x:a). pred i x ==> pred (i + 1) (f i x) + +val repeati_inductive': + #a:Type + -> n:nat + -> pred:(i:nat{i <= n} -> a -> Type0) + -> f:(i:nat{i < n} -> a -> a) + -> x0:a + -> Pure a + (requires preserves #a #n f pred /\ pred 0 x0) + (ensures fun res -> pred n res /\ res == repeati n f x0) diff --git a/tests/hacl/Lib.Sequence.Lemmas.fst b/tests/hacl/Lib.Sequence.Lemmas.fst new file mode 100644 index 00000000000..d819a097ee1 --- /dev/null +++ b/tests/hacl/Lib.Sequence.Lemmas.fst @@ -0,0 +1,801 @@ +module Lib.Sequence.Lemmas + +open FStar.Mul +open Lib.IntTypes +open Lib.Sequence + +#set-options "--z3rlimit 30 --max_fuel 0 --max_ifuel 0 \ + --using_facts_from '-* +Prims +FStar.Pervasives +FStar.Math.Lemmas +FStar.Seq \ + +Lib.IntTypes +Lib.Sequence +Lib.Sequence.Lemmas +Lib.LoopCombinators'" + + +let rec repeati_extensionality #a n f g acc0 = + if n = 0 then begin + Loops.eq_repeati0 n f acc0; + Loops.eq_repeati0 n g acc0 end + else begin + Loops.unfold_repeati n f acc0 (n-1); + Loops.unfold_repeati n g acc0 (n-1); + repeati_extensionality #a (n-1) f g acc0 end + + +let rec repeat_right_extensionality n lo a_f a_g f g acc0 = + if n = 0 then begin + Loops.eq_repeat_right lo (lo + n) a_f f acc0; + Loops.eq_repeat_right lo (lo + n) a_g g acc0 end + else begin + Loops.unfold_repeat_right lo (lo + n) a_f f acc0 (lo + n - 1); + Loops.unfold_repeat_right lo (lo + n) a_g g acc0 (lo + n - 1); + repeat_right_extensionality (n - 1) lo a_f a_g f g acc0 end + + +let rec repeat_gen_right_extensionality n lo_g a_f a_g f g acc0 = + if n = 0 then begin + Loops.eq_repeat_right 0 n a_f f acc0; + Loops.eq_repeat_right lo_g (lo_g+n) a_g g acc0 end + else begin + Loops.unfold_repeat_right 0 n a_f f acc0 (n-1); + Loops.unfold_repeat_right lo_g (lo_g+n) a_g g acc0 (lo_g+n-1); + repeat_gen_right_extensionality (n-1) lo_g a_f a_g f g acc0 end + + +let repeati_right_extensionality #a n lo_g f g acc0 = + repeat_gen_right_extensionality n lo_g (Loops.fixed_a a) (Loops.fixed_a a) f g acc0 + + +let repeati_right_shift #a n f g acc0 = + let acc1 = g 0 acc0 in + repeati_right_extensionality n 1 f g acc1; + // Got: + // repeat_right 0 n (fun _ -> a) f acc1 == repeat_right 1 (n + 1) (fun _ -> a) g acc1 + Loops.repeati_def n f acc1; + // Got: + // repeati n f acc1 == repeat_right 0 n (fun _ -> a) f acc1 + Loops.repeat_right_plus 0 1 (n + 1) (Loops.fixed_a a) g acc0; + // Got: + // repeat_right 0 (n + 1) (fixed_a a) g acc0 == + // repeat_right 1 (n + 1) (fixed_a a) g (repeat_right 0 1 (fixed_a a) g acc0) + Loops.unfold_repeat_right 0 (n + 1) (Loops.fixed_a a) g acc0 0; + Loops.eq_repeat_right 0 (n + 1) (Loops.fixed_a a) g acc0; + Loops.repeati_def (n + 1) g acc0 + + +let repeat_gen_blocks_multi #inp_t blocksize mi hi n inp a f acc0 = + Loops.repeat_right mi (mi + n) a (repeat_gen_blocks_f blocksize mi hi n inp a f) acc0 + + +let lemma_repeat_gen_blocks_multi #inp_t blocksize mi hi n inp a f acc0 = () + + +let repeat_gen_blocks #inp_t #c blocksize mi hi inp a f l acc0 = + let len = length inp in + let nb = len / blocksize in + let rem = len % blocksize in + let blocks = Seq.slice inp 0 (nb * blocksize) in + let last = Seq.slice inp (nb * blocksize) len in + Math.Lemmas.cancel_mul_div nb blocksize; + let acc = repeat_gen_blocks_multi #inp_t blocksize mi hi nb blocks a f acc0 in + l (mi + nb) rem last acc + + +let lemma_repeat_gen_blocks #inp_t #c blocksize mi hi inp a f l acc0 = () + + +let repeat_gen_blocks_multi_extensionality_zero #inp_t blocksize mi hi_f hi_g n inp a_f a_g f g acc0 = + let f_rep = repeat_gen_blocks_f blocksize mi hi_f n inp a_f f in + let g_rep = repeat_gen_blocks_f blocksize 0 hi_g n inp a_g g in + repeat_gen_right_extensionality n mi a_g a_f g_rep f_rep acc0 + + +let repeat_gen_blocks_extensionality_zero #inp_t #c blocksize mi hi_f hi_g n inp a_f a_g f l_f g l_g acc0 = + let len = length inp in + let rem = len % blocksize in + Math.Lemmas.cancel_mul_div n blocksize; + Math.Lemmas.cancel_mul_mod n blocksize; + let blocks = Seq.slice inp 0 (n * blocksize) in + let block_l = Seq.slice inp (n * blocksize) len in + let acc_f = repeat_gen_blocks_multi blocksize mi hi_f n blocks a_f f acc0 in + let acc_g = repeat_gen_blocks_multi blocksize 0 hi_g n blocks a_g g acc0 in + + calc (==) { + repeat_gen_blocks blocksize mi hi_f inp a_f f l_f acc0; + (==) { } + l_f (mi + n) rem block_l acc_f; + (==) { repeat_gen_blocks_multi_extensionality_zero #inp_t blocksize mi hi_f hi_g n blocks a_f a_g f g acc0 } + l_f (mi + n) rem block_l acc_g; + (==) { } + l_g n rem block_l acc_g; + (==) { } + repeat_gen_blocks blocksize 0 hi_g inp a_g g l_g acc0; + } + + +let len0_div_bs blocksize len len0 = + let k = len0 / blocksize in + calc (==) { + k + (len - len0) / blocksize; + == { Math.Lemmas.lemma_div_exact len0 blocksize } + k + (len - k * blocksize) / blocksize; + == { Math.Lemmas.division_sub_lemma len blocksize k } + k + len / blocksize - k; + == { } + len / blocksize; + } + + +let split_len_lemma0 blocksize n len0 = + let len = n * blocksize in + let len1 = len - len0 in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + Math.Lemmas.cancel_mul_mod n blocksize; + //assert (len % blocksize = 0); + + Math.Lemmas.lemma_mod_sub_distr len len0 blocksize; + //assert (len1 % blocksize = 0); + + Math.Lemmas.lemma_div_exact len0 blocksize; + //assert (n0 * blocksize = len0); + + Math.Lemmas.lemma_div_exact len1 blocksize; + //assert (n1 * blocksize = len1); + + len0_div_bs blocksize len len0 + //assert (n0 + n1 = n) + + +let split_len_lemma blocksize len len0 = + let len1 = len - len0 in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + let n = len / blocksize in + + Math.Lemmas.lemma_mod_sub_distr len len0 blocksize; + //assert (len % blocksize = len1 % blocksize); + + Math.Lemmas.lemma_div_exact len0 blocksize; + //assert (n0 * blocksize = len0); + + len0_div_bs blocksize len len0 + //assert (n0 + n1 = n) + +//////////////////////// +// Start of proof of repeat_gen_blocks_multi_split lemma +//////////////////////// + +val aux_repeat_bf_s0: + #inp_t:Type0 + -> blocksize:size_pos + -> len0:nat{len0 % blocksize == 0} + -> mi:nat + -> hi:nat + -> n:nat{mi + n <= hi} + -> inp:seq inp_t{len0 <= length inp /\ length inp == n * blocksize} + -> a:(i:nat{i <= hi} -> Type) + -> f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> i:nat{mi <= i /\ i < mi + len0 / blocksize /\ i < hi} // i < hi is needed to type-check the definition + -> acc:a i -> + Lemma + (let len = length inp in + let n0 = len0 / blocksize in + split_len_lemma0 blocksize n len0; + + let t0 = Seq.slice inp 0 len0 in + let repeat_bf_s0 = repeat_gen_blocks_f blocksize mi hi n0 t0 a f in + let repeat_bf_t = repeat_gen_blocks_f blocksize mi hi n inp a f in + + repeat_bf_s0 i acc == repeat_bf_t i acc) + +let aux_repeat_bf_s0 #inp_t blocksize len0 mi hi n inp a f i acc = + let len = length inp in + let n0 = len0 / blocksize in + split_len_lemma0 blocksize n len0; + + let t0 = Seq.slice inp 0 len0 in + let repeat_bf_s0 = repeat_gen_blocks_f blocksize mi hi n0 t0 a f in + let repeat_bf_t = repeat_gen_blocks_f blocksize mi hi n inp a f in + + let i_b = i - mi in + Math.Lemmas.lemma_mult_le_right blocksize (i_b + 1) n; + let block = Seq.slice inp (i_b * blocksize) (i_b * blocksize + blocksize) in + assert (repeat_bf_t i acc == f i block acc); + + Math.Lemmas.lemma_mult_le_right blocksize (i_b + 1) n0; + Seq.slice_slice inp 0 len0 (i_b * blocksize) (i_b * blocksize + blocksize); + assert (repeat_bf_s0 i acc == f i block acc) + + +val aux_repeat_bf_s1: + #inp_t:Type0 + -> blocksize:size_pos + -> len0:nat{len0 % blocksize == 0} + -> mi:nat + -> hi:nat + -> n:nat{mi + n <= hi} + -> inp:seq inp_t{len0 <= length inp /\ length inp == n * blocksize} + -> a:(i:nat{i <= hi} -> Type) + -> f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> i:nat{mi + len0 / blocksize <= i /\ i < mi + n} + -> acc:a i -> + Lemma + (let len = length inp in + let len1 = len - len0 in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + split_len_lemma0 blocksize n len0; + + let t1 = Seq.slice inp len0 len in + let repeat_bf_s1 = repeat_gen_blocks_f blocksize (mi + n0) hi n1 t1 a f in + let repeat_bf_t = repeat_gen_blocks_f blocksize mi hi n inp a f in + + repeat_bf_s1 i acc == repeat_bf_t i acc) + +let aux_repeat_bf_s1 #inp_t blocksize len0 mi hi n inp a f i acc = + let len = length inp in + let len1 = len - len0 in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + split_len_lemma0 blocksize n len0; + + let t1 = Seq.slice inp len0 len in + let repeat_bf_s1 = repeat_gen_blocks_f blocksize (mi + n0) hi n1 t1 a f in + let repeat_bf_t = repeat_gen_blocks_f blocksize mi hi n inp a f in + + let i_b = i - mi in + Math.Lemmas.lemma_mult_le_right blocksize (i_b + 1) n; + let block = Seq.slice inp (i_b * blocksize) (i_b * blocksize + blocksize) in + assert (repeat_bf_t i acc == f i block acc); + + let i_b1 = i - mi - n0 in + calc (<=) { + i_b1 * blocksize + blocksize; + (<=) { Math.Lemmas.lemma_mult_le_right blocksize (i_b1 + 1) n1 } + n1 * blocksize; + (==) { Math.Lemmas.div_exact_r len1 blocksize } + len1; + }; + + calc (==) { + len0 + i_b1 * blocksize; + (==) { Math.Lemmas.div_exact_r len0 blocksize } + n0 * blocksize + i_b1 * blocksize; + (==) { Math.Lemmas.distributivity_add_left n0 i_b1 blocksize } + (n0 + i_b1) * blocksize; + }; + + Seq.slice_slice inp len0 len (i_b1 * blocksize) (i_b1 * blocksize + blocksize); + assert (repeat_bf_s1 i acc == f i block acc) + + +let repeat_gen_blocks_multi_split #inp_t blocksize len0 mi hi n inp a f acc0 = + let len = length inp in + let len1 = len - len0 in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + split_len_lemma0 blocksize n len0; + + let t0 = Seq.slice inp 0 len0 in + let t1 = Seq.slice inp len0 len in + + let repeat_bf_s0 = repeat_gen_blocks_f blocksize mi hi n0 t0 a f in + let repeat_bf_s1 = repeat_gen_blocks_f blocksize (mi + n0) hi n1 t1 a f in + let repeat_bf_t = repeat_gen_blocks_f blocksize mi hi n inp a f in + + let acc1 : a (mi + n0) = repeat_gen_blocks_multi blocksize mi hi n0 t0 a f acc0 in + //let acc2 = repeat_gen_blocks_multi blocksize (mi + n0) hi n1 t1 a f acc1 in + + calc (==) { + repeat_gen_blocks_multi blocksize mi hi n0 t0 a f acc0; + (==) { } + Loops.repeat_right mi (mi + n0) a repeat_bf_s0 acc0; + (==) { Classical.forall_intro_2 (aux_repeat_bf_s0 #inp_t blocksize len0 mi hi n inp a f); + repeat_right_extensionality n0 mi a a repeat_bf_s0 repeat_bf_t acc0 } + Loops.repeat_right mi (mi + n0) a repeat_bf_t acc0; + }; + + calc (==) { + repeat_gen_blocks_multi blocksize (mi + n0) hi n1 t1 a f acc1; + (==) { } + Loops.repeat_right (mi + n0) (mi + n) a repeat_bf_s1 acc1; + (==) { Classical.forall_intro_2 (aux_repeat_bf_s1 #inp_t blocksize len0 mi hi n inp a f); + repeat_right_extensionality n1 (mi + n0) a a repeat_bf_s1 repeat_bf_t acc1 } + Loops.repeat_right (mi + n0) (mi + n) a repeat_bf_t acc1; + (==) { Loops.repeat_right_plus mi (mi + n0) (mi + n) a repeat_bf_t acc0 } + Loops.repeat_right mi (mi + n) a repeat_bf_t acc0; + (==) { } + repeat_gen_blocks_multi blocksize mi hi n inp a f acc0; + } + +//////////////////////// +// End of proof of repeat_gen_blocks_multi_split lemma +//////////////////////// + + +val repeat_gen_blocks_multi_split_slice: + #inp_t:Type0 + -> blocksize:size_pos + -> len0:nat{len0 % blocksize == 0} + -> mi:nat + -> hi:nat + -> inp:seq inp_t{len0 <= length inp / blocksize * blocksize /\ mi + length inp / blocksize <= hi} + -> a:(i:nat{i <= hi} -> Type) + -> f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> acc0:a mi -> + Lemma + (let len = length inp in + let len1 = len - len0 in + let n = len / blocksize in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + split_len_lemma blocksize len len0; + split_len_lemma0 blocksize n len0; + + let blocks = Seq.slice inp 0 (n * blocksize) in + let t0 = Seq.slice inp 0 len0 in + let t1 = Seq.slice inp len0 (n * blocksize) in + + let acc1 : a (mi + n0) = repeat_gen_blocks_multi blocksize mi hi n0 t0 a f acc0 in + repeat_gen_blocks_multi blocksize mi hi n blocks a f acc0 == + repeat_gen_blocks_multi blocksize (mi + n0) hi n1 t1 a f acc1) + +let repeat_gen_blocks_multi_split_slice #inp_t blocksize len0 mi hi inp a f acc0 = + let len = length inp in + let n = len / blocksize in + split_len_lemma blocksize len len0; + let blocks = Seq.slice inp 0 (n * blocksize) in + split_len_lemma0 blocksize n len0; + repeat_gen_blocks_multi_split blocksize len0 mi hi n blocks a f acc0 + + +val slice_slice_last: + #inp_t:Type0 + -> blocksize:size_pos + -> len0:nat{len0 % blocksize = 0} + -> inp:seq inp_t{len0 <= length inp} -> + Lemma + (let len = length inp in + let len1 = len - len0 in + let n = len / blocksize in + let n1 = len1 / blocksize in + let t1 = Seq.slice inp len0 len in + Seq.slice t1 (n1 * blocksize) len1 `Seq.equal` + Seq.slice inp (n * blocksize) len) + +let slice_slice_last #inp_t blocksize len0 inp = + let len = length inp in + let len1 = len - len0 in + let n = len / blocksize in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + + calc (==) { + len0 + n1 * blocksize; + (==) { len0_div_bs blocksize len len0 } + len0 + (n - n0) * blocksize; + (==) { Math.Lemmas.distributivity_sub_left n n0 blocksize } + len0 + n * blocksize - n0 * blocksize; + (==) { Math.Lemmas.div_exact_r len0 blocksize } + n * blocksize; + }; + + let t1 = Seq.slice inp len0 len in + Seq.slice_slice inp len0 len (n1 * blocksize) len1 + + +val len0_le_len_fraction: blocksize:pos -> len:nat -> len0:nat -> + Lemma + (requires len0 <= len /\ len0 % blocksize = 0) + (ensures len0 <= len / blocksize * blocksize) + +let len0_le_len_fraction blocksize len len0 = + Math.Lemmas.lemma_div_le len0 len blocksize; + Math.Lemmas.lemma_mult_le_right blocksize (len0 / blocksize) (len / blocksize) + +#push-options "--z3rlimit 100" +let repeat_gen_blocks_split #inp_t #c blocksize len0 hi mi inp a f l acc0 = + let len = length inp in + let len1 = len - len0 in + let n = len / blocksize in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + len0_le_len_fraction blocksize len len0; + split_len_lemma blocksize len len0; + split_len_lemma0 blocksize n len0; + + let t0 = Seq.slice inp 0 len0 in + let t1 = Seq.slice inp len0 len in + + let acc = repeat_gen_blocks_multi blocksize mi hi n0 t0 a f acc0 in + let blocks1 = Seq.slice t1 0 (n1 * blocksize) in + Math.Lemmas.cancel_mul_mod n1 blocksize; + let acc1 = repeat_gen_blocks_multi blocksize (mi + n0) hi n1 blocks1 a f acc in + + calc (==) { + repeat_gen_blocks_multi blocksize (mi + n0) hi n1 blocks1 a f acc; + (==) { repeat_gen_blocks_multi_split_slice #inp_t blocksize len0 mi hi inp a f acc0 } + repeat_gen_blocks_multi blocksize mi hi n (Seq.slice inp 0 (n * blocksize)) a f acc0; + }; + + calc (==) { + repeat_gen_blocks blocksize (mi + n0) hi t1 a f l acc; + (==) { len0_div_bs blocksize len len0 } + l (mi + n) (len1 % blocksize) (Seq.slice t1 (n1 * blocksize) len1) acc1; + (==) { Math.Lemmas.lemma_mod_sub_distr len len0 blocksize } + l (mi + n) (len % blocksize) (Seq.slice t1 (n1 * blocksize) len1) acc1; + (==) { slice_slice_last #inp_t blocksize len0 inp } + l (mi + n) (len % blocksize) (Seq.slice inp (n * blocksize) len) acc1; + } +#pop-options + +//////////////////////// +// Start of repeat_blocks-related properties +//////////////////////// + +let repeat_blocks_extensionality #a #b #c blocksize inp f1 f2 l1 l2 acc0 = + let len = length inp in + let nb = len / blocksize in + + let f_rep1 = repeat_blocks_f blocksize inp f1 nb in + let f_rep2 = repeat_blocks_f blocksize inp f2 nb in + + let acc1 = Loops.repeati nb f_rep1 acc0 in + let acc2 = Loops.repeati nb f_rep2 acc0 in + lemma_repeat_blocks blocksize inp f1 l1 acc0; + lemma_repeat_blocks blocksize inp f2 l2 acc0; + + let aux (i:nat{i < nb}) (acc:b) : Lemma (f_rep1 i acc == f_rep2 i acc) = + Math.Lemmas.lemma_mult_le_right blocksize (i + 1) nb; + Seq.Properties.slice_slice inp 0 (nb * blocksize) (i * blocksize) (i * blocksize + blocksize) in + + Classical.forall_intro_2 aux; + repeati_extensionality nb f_rep1 f_rep2 acc0 + + +let lemma_repeat_blocks_via_multi #a #b #c blocksize inp f l acc0 = + let len = length inp in + let nb = len / blocksize in + + let blocks = Seq.slice inp 0 (nb * blocksize) in + Math.Lemmas.cancel_mul_div nb blocksize; + Math.Lemmas.cancel_mul_mod nb blocksize; + + let f_rep_b = repeat_blocks_f blocksize blocks f nb in + let f_rep = repeat_blocks_f blocksize inp f nb in + + let aux (i:nat{i < nb}) (acc:b) : Lemma (f_rep_b i acc == f_rep i acc) = + Math.Lemmas.lemma_mult_le_right blocksize (i + 1) nb; + Seq.Properties.slice_slice inp 0 (nb * blocksize) (i * blocksize) (i * blocksize + blocksize) in + + lemma_repeat_blocks #a #b #c blocksize inp f l acc0; + calc (==) { + Loops.repeati nb f_rep acc0; + (==) { Classical.forall_intro_2 aux; repeati_extensionality nb f_rep f_rep_b acc0 } + Loops.repeati nb f_rep_b acc0; + (==) { lemma_repeat_blocks_multi blocksize blocks f acc0 } + repeat_blocks_multi blocksize blocks f acc0; + } + + +let repeat_blocks_multi_is_repeat_gen_blocks_multi #a #b hi blocksize inp f acc0 = + let len = length inp in + let n = len / blocksize in + Math.Lemmas.div_exact_r len blocksize; + + let f_rep = repeat_blocks_f blocksize inp f n in + let f_gen = repeat_gen_blocks_f blocksize 0 hi n inp (Loops.fixed_a b) (Loops.fixed_i f) in + + let aux (i:nat{i < n}) (acc:b) : Lemma (f_rep i acc == f_gen i acc) = () in + + calc (==) { + repeat_blocks_multi #a #b blocksize inp f acc0; + (==) { lemma_repeat_blocks_multi #a #b blocksize inp f acc0 } + Loops.repeati n f_rep acc0; + (==) { Loops.repeati_def n (repeat_blocks_f blocksize inp f n) acc0 } + Loops.repeat_right 0 n (Loops.fixed_a b) f_rep acc0; + (==) { Classical.forall_intro_2 aux; + repeat_gen_right_extensionality n 0 (Loops.fixed_a b) (Loops.fixed_a b) f_rep f_gen acc0 } + Loops.repeat_right 0 n (Loops.fixed_a b) f_gen acc0; + } + + +let repeat_blocks_is_repeat_gen_blocks #a #b #c hi blocksize inp f l acc0 = + let len = length inp in + let nb = len / blocksize in + //let rem = len % blocksize in + + Math.Lemmas.cancel_mul_div nb blocksize; + Math.Lemmas.cancel_mul_mod nb blocksize; + + let blocks = Seq.slice inp 0 (nb * blocksize) in + lemma_repeat_blocks_via_multi #a #b #c blocksize inp f l acc0; + calc (==) { + repeat_blocks_multi blocksize blocks f acc0; + (==) { repeat_blocks_multi_is_repeat_gen_blocks_multi #a #b hi blocksize blocks f acc0 } + repeat_gen_blocks_multi blocksize 0 hi nb blocks (Loops.fixed_a b) (Loops.fixed_i f) acc0; + } + + +let repeat_blocks_multi_split #a #b blocksize len0 inp f acc0 = + let len = length inp in + let len1 = len - len0 in + let n = len / blocksize in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + len0_le_len_fraction blocksize len len0; + split_len_lemma0 blocksize n len0; + + let t0 = Seq.slice inp 0 len0 in + let t1 = Seq.slice inp len0 len in + let acc1 = repeat_gen_blocks_multi blocksize 0 n n0 t0 (Loops.fixed_a b) (Loops.fixed_i f) acc0 in + + calc (==) { + repeat_gen_blocks_multi blocksize 0 n n0 t0 (Loops.fixed_a b) (Loops.fixed_i f) acc0; + (==) { repeat_gen_blocks_multi_extensionality_zero blocksize 0 n0 n n0 t0 + (Loops.fixed_a b) (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i f) acc0} + repeat_gen_blocks_multi blocksize 0 n0 n0 t0 (Loops.fixed_a b) (Loops.fixed_i f) acc0; + (==) { repeat_blocks_multi_is_repeat_gen_blocks_multi #a #b n0 blocksize t0 f acc0 } + repeat_blocks_multi blocksize t0 f acc0; + }; + + calc (==) { + repeat_blocks_multi blocksize inp f acc0; + (==) { repeat_blocks_multi_is_repeat_gen_blocks_multi #a #b n blocksize inp f acc0 } + repeat_gen_blocks_multi blocksize 0 n n inp (Loops.fixed_a b) (Loops.fixed_i f) acc0; + (==) { repeat_gen_blocks_multi_split #a blocksize len0 0 n n inp (Loops.fixed_a b) (Loops.fixed_i f) acc0 } + repeat_gen_blocks_multi blocksize n0 n n1 t1 (Loops.fixed_a b) (Loops.fixed_i f) acc1; + (==) { repeat_gen_blocks_multi_extensionality_zero blocksize n0 n n1 n1 t1 + (Loops.fixed_a b) (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i f) acc1 } + repeat_gen_blocks_multi blocksize 0 n1 n1 t1 (Loops.fixed_a b) (Loops.fixed_i f) acc1; + (==) { repeat_blocks_multi_is_repeat_gen_blocks_multi #a #b n1 blocksize t1 f acc1 } + repeat_blocks_multi blocksize t1 f acc1; + } + + +let repeat_blocks_split #a #b #c blocksize len0 inp f l acc0 = + let len = length inp in + let len1 = len - len0 in + let n = len / blocksize in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + len0_le_len_fraction blocksize len len0; + split_len_lemma blocksize len len0; + + let t0 = Seq.slice inp 0 len0 in + let t1 = Seq.slice inp len0 len in + let acc1 = repeat_gen_blocks_multi blocksize 0 n n0 t0 (Loops.fixed_a b) (Loops.fixed_i f) acc0 in + + calc (==) { + repeat_gen_blocks_multi blocksize 0 n n0 t0 (Loops.fixed_a b) (Loops.fixed_i f) acc0; + (==) { repeat_gen_blocks_multi_extensionality_zero blocksize 0 n0 n n0 t0 + (Loops.fixed_a b) (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i f) acc0} + repeat_gen_blocks_multi blocksize 0 n0 n0 t0 (Loops.fixed_a b) (Loops.fixed_i f) acc0; + (==) { repeat_blocks_multi_is_repeat_gen_blocks_multi #a #b n0 blocksize t0 f acc0 } + repeat_blocks_multi blocksize t0 f acc0; + }; + + calc (==) { + repeat_blocks blocksize inp f l acc0; + (==) { repeat_blocks_is_repeat_gen_blocks n blocksize inp f l acc0 } + repeat_gen_blocks blocksize 0 n inp (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i l) acc0; + (==) { repeat_gen_blocks_split #a #c blocksize len0 n 0 inp + (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i l) acc0 } + repeat_gen_blocks blocksize n0 n t1 (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i l) acc1; + (==) { repeat_gen_blocks_extensionality_zero blocksize n0 n n1 n1 t1 + (Loops.fixed_a b) (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i l) + (Loops.fixed_i f) (Loops.fixed_i l) acc1 } + repeat_gen_blocks blocksize 0 n1 t1 (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i l) acc1; + (==) { repeat_blocks_is_repeat_gen_blocks #a #b #c n1 blocksize t1 f l acc1 } + repeat_blocks blocksize t1 f l acc1; + } + +let repeat_blocks_multi_extensionality #a #b blocksize inp f g init = + let len = length inp in + let nb = len / blocksize in + let f_rep = repeat_blocks_f blocksize inp f nb in + let g_rep = repeat_blocks_f blocksize inp g nb in + + lemma_repeat_blocks_multi blocksize inp f init; + lemma_repeat_blocks_multi blocksize inp g init; + + let aux (i:nat{i < nb}) (acc:b) : Lemma (f_rep i acc == g_rep i acc) = + Math.Lemmas.lemma_mult_le_right blocksize (i + 1) nb; + Seq.Properties.slice_slice inp 0 (nb * blocksize) (i * blocksize) (i * blocksize + blocksize) in + + Classical.forall_intro_2 aux; + repeati_extensionality nb f_rep g_rep init + + +//////////////////////// +// End of repeat_blocks-related properties +//////////////////////// + +let map_blocks_multi_extensionality #a blocksize max n inp f g = + let a_map = map_blocks_a a blocksize max in + let acc0 : a_map 0 = Seq.empty #a in + + calc (==) { + map_blocks_multi blocksize max n inp f; + (==) { lemma_map_blocks_multi blocksize max n inp f } + Loops.repeat_gen n a_map (map_blocks_f #a blocksize max inp f) acc0; + (==) { Loops.repeat_gen_def n a_map (map_blocks_f #a blocksize max inp f) acc0 } + Loops.repeat_right 0 n a_map (map_blocks_f #a blocksize max inp f) acc0; + (==) { repeat_right_extensionality n 0 a_map a_map + (map_blocks_f #a blocksize max inp f) (map_blocks_f #a blocksize max inp g) acc0 } + Loops.repeat_right 0 n a_map (map_blocks_f #a blocksize max inp g) acc0; + (==) { Loops.repeat_gen_def n a_map (map_blocks_f #a blocksize max inp g) acc0 } + Loops.repeat_gen n a_map (map_blocks_f #a blocksize max inp g) acc0; + (==) { lemma_map_blocks_multi blocksize max n inp g } + map_blocks_multi blocksize max n inp g; + } + + +let map_blocks_extensionality #a blocksize inp f l_f g l_g = + let len = length inp in + let n = len / blocksize in + let blocks = Seq.slice inp 0 (n * blocksize) in + + lemma_map_blocks blocksize inp f l_f; + lemma_map_blocks blocksize inp g l_g; + map_blocks_multi_extensionality #a blocksize n n blocks f g + + +let repeat_gen_blocks_map_l_length #a blocksize hi l i rem block_l acc = () + + +let map_blocks_multi_acc #a blocksize mi hi n inp f acc0 = + repeat_gen_blocks_multi #a blocksize mi hi n inp + (map_blocks_a a blocksize hi) + (repeat_gen_blocks_map_f blocksize hi f) acc0 + + +let map_blocks_acc #a blocksize mi hi inp f l acc0 = + repeat_gen_blocks #a blocksize mi hi inp + (map_blocks_a a blocksize hi) + (repeat_gen_blocks_map_f blocksize hi f) + (repeat_gen_blocks_map_l blocksize hi l) acc0 + +let map_blocks_acc_length #a blocksize mi hi inp f l acc0 = () + +let map_blocks_multi_acc_is_repeat_gen_blocks_multi #a blocksize mi hi n inp f acc0 = () + +let map_blocks_acc_is_repeat_gen_blocks #a blocksize mi hi inp f l acc0 = () + +#push-options "--z3rlimit 150" +val map_blocks_multi_acc_is_map_blocks_multi_: + #a:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi_f:nat + -> hi_g:nat + -> n:nat{mi + hi_g <= hi_f /\ n <= hi_g} + -> inp:seq a{length inp == hi_g * blocksize} + -> f:(i:nat{i < hi_f} -> lseq a blocksize -> lseq a blocksize) + -> acc0:map_blocks_a a blocksize hi_f mi -> + Lemma + (let a_f = map_blocks_a a blocksize hi_f in + let a_g = map_blocks_a a blocksize hi_g in + let f_gen_map = repeat_gen_blocks_map_f blocksize hi_f f in + let f_gen = repeat_gen_blocks_f blocksize mi hi_f hi_g inp a_f f_gen_map in + + let f_map = map_blocks_f #a blocksize hi_g inp (f_shift blocksize mi hi_f hi_g f) in + + Loops.repeat_right mi (mi + n) a_f f_gen acc0 == + Seq.append acc0 (Loops.repeat_right 0 n a_g f_map (Seq.empty #a))) + +let rec map_blocks_multi_acc_is_map_blocks_multi_ #a blocksize mi hi_f hi_g n inp f acc0 = + let a_f = map_blocks_a a blocksize hi_f in + let a_g = map_blocks_a a blocksize hi_g in + let f_gen_map = repeat_gen_blocks_map_f blocksize hi_f f in + let f_gen = repeat_gen_blocks_f blocksize mi hi_f hi_g inp a_f f_gen_map in + + let f_sh = f_shift blocksize mi hi_f hi_g f in + let f_map = map_blocks_f #a blocksize hi_g inp f_sh in + let lp = Loops.repeat_right mi (mi + n) a_f f_gen acc0 in + let rp = Loops.repeat_right 0 n a_g f_map (Seq.empty #a) in + + if n = 0 then begin + Loops.eq_repeat_right mi (mi + n) a_f f_gen acc0; + Loops.eq_repeat_right 0 n a_g f_map (Seq.empty #a); + Seq.Base.append_empty_r acc0 end + else begin + let lp1 = Loops.repeat_right mi (mi + n - 1) a_f f_gen acc0 in + let rp1 = Loops.repeat_right 0 (n - 1) a_g f_map (Seq.empty #a) in + let block = Seq.slice inp ((n - 1) * blocksize) (n * blocksize) in + Loops.unfold_repeat_right 0 n a_g f_map (Seq.empty #a) (n - 1); + assert (rp == f_map (n - 1) rp1); + assert (rp == Seq.append rp1 (f (mi + n - 1) block)); + + calc (==) { + Loops.repeat_right mi (mi + n) a_f f_gen acc0; + (==) { Loops.unfold_repeat_right mi (mi + n) a_f f_gen acc0 (mi + n - 1) } + Seq.append lp1 (f (mi + n - 1) block); + (==) { map_blocks_multi_acc_is_map_blocks_multi_ #a blocksize mi hi_f hi_g (n - 1) inp f acc0 } + Seq.append (Seq.append acc0 rp1) (f (mi + n - 1) block); + (==) { Seq.Base.append_assoc acc0 rp1 (f (mi + n - 1) block) } + Seq.append acc0 (Seq.append rp1 (f (mi + n - 1) block)); + } end +#pop-options + +let map_blocks_multi_acc_is_map_blocks_multi #a blocksize mi hi n inp f acc0 = + let f_map = repeat_gen_blocks_map_f blocksize hi f in + let a_map = map_blocks_a a blocksize hi in + let f_gen = repeat_gen_blocks_f blocksize mi hi n inp a_map f_map in + + let f_map_s = f_shift blocksize mi hi n f in + let a_map_s = map_blocks_a a blocksize n in + let f_gen_s = map_blocks_f #a blocksize n inp f_map_s in + + calc (==) { + Seq.append acc0 (map_blocks_multi blocksize n n inp f_map_s); + (==) { lemma_map_blocks_multi blocksize n n inp f_map_s } + Seq.append acc0 (Loops.repeat_gen n a_map_s f_gen_s (Seq.empty #a)); + (==) { Loops.repeat_gen_def n a_map_s f_gen_s (Seq.empty #a) } + Seq.append acc0 (Loops.repeat_right 0 n a_map_s f_gen_s (Seq.empty #a)); + (==) { map_blocks_multi_acc_is_map_blocks_multi_ #a blocksize mi hi n n inp f acc0 } + Loops.repeat_right mi (mi + n) a_map f_gen acc0; + (==) { } + map_blocks_multi_acc #a blocksize mi hi n inp f acc0; + } + + +let map_blocks_acc_is_map_blocks #a blocksize mi hi inp f l acc0 = + let len = length inp in + let n = len / blocksize in + Math.Lemmas.cancel_mul_div n blocksize; + let blocks = Seq.slice inp 0 (n * blocksize) in + + let f_sh = f_shift blocksize mi hi n f in + let l_sh = l_shift blocksize mi hi n l in + lemma_map_blocks #a blocksize inp f_sh l_sh; + map_blocks_multi_acc_is_map_blocks_multi #a blocksize mi hi n blocks f acc0 + + +let map_blocks_multi_acc_is_map_blocks_multi0 #a blocksize hi n inp f = + let f_sh = f_shift blocksize 0 hi n f in + let a_map = map_blocks_a a blocksize n in + let acc0 : a_map 0 = Seq.empty #a in + + calc (==) { + map_blocks_multi_acc blocksize 0 hi n inp f Seq.empty; + (==) { map_blocks_multi_acc_is_map_blocks_multi #a blocksize 0 hi n inp f Seq.empty } + Seq.append Seq.empty (map_blocks_multi blocksize n n inp f_sh); + (==) { Seq.Base.append_empty_l (map_blocks_multi blocksize n n inp f_sh) } + map_blocks_multi blocksize n n inp f_sh; + (==) { map_blocks_multi_extensionality blocksize n n inp f_sh f } + map_blocks_multi blocksize n n inp f; + } + + +let map_blocks_acc_is_map_blocks0 #a blocksize hi inp f l = + let len = length inp in + let n = len / blocksize in + let f_sh = f_shift blocksize 0 hi n f in + let l_sh = l_shift blocksize 0 hi n l in + + calc (==) { + map_blocks_acc #a blocksize 0 hi inp f l Seq.empty; + (==) { map_blocks_acc_is_map_blocks blocksize 0 hi inp f l Seq.empty } + Seq.append Seq.empty (map_blocks #a blocksize inp f_sh l_sh); + (==) { Seq.Base.append_empty_l (map_blocks #a blocksize inp f_sh l_sh) } + map_blocks #a blocksize inp f_sh l_sh; + (==) { map_blocks_extensionality #a blocksize inp f l f_sh l_sh } + map_blocks #a blocksize inp f l; + } + + +let map_blocks_is_empty #a blocksize hi inp f l = + let len = length inp in + let nb = len / blocksize in + let rem = len % blocksize in + let blocks = Seq.slice inp 0 (nb * blocksize) in + + assert (rem == 0); + calc (==) { + map_blocks blocksize inp f l; + (==) { lemma_map_blocks blocksize inp f l } + map_blocks_multi #a blocksize nb nb blocks f; + (==) { lemma_map_blocks_multi blocksize nb nb blocks f } + Loops.repeat_gen nb (map_blocks_a a blocksize nb) (map_blocks_f #a blocksize nb inp f) Seq.empty; + (==) { Loops.eq_repeat_gen0 nb (map_blocks_a a blocksize nb) (map_blocks_f #a blocksize nb inp f) Seq.empty } + Seq.empty; + } diff --git a/tests/hacl/Lib.Sequence.Lemmas.fsti b/tests/hacl/Lib.Sequence.Lemmas.fsti new file mode 100644 index 00000000000..220eef1d100 --- /dev/null +++ b/tests/hacl/Lib.Sequence.Lemmas.fsti @@ -0,0 +1,701 @@ +module Lib.Sequence.Lemmas + +open FStar.Mul +open Lib.IntTypes +open Lib.Sequence + +module Loops = Lib.LoopCombinators + +#set-options "--z3rlimit 50 --max_fuel 0 --max_ifuel 0 \ + --using_facts_from '-* +Prims +FStar.Math.Lemmas +FStar.Seq +Lib.IntTypes +Lib.Sequence +Lib.Sequence.Lemmas'" + + +let get_block_s + (#a:Type) + (#len:nat) + (blocksize:size_pos) + (inp:seq a{length inp == len}) + (i:nat{i < len / blocksize * blocksize}) : + lseq a blocksize += + div_mul_lt blocksize i (len / blocksize); + let j = i / blocksize in + let b: lseq a blocksize = Seq.slice inp (j * blocksize) ((j + 1) * blocksize) in + b + + +let get_last_s + (#a:Type) + (#len:nat) + (blocksize:size_pos) + (inp:seq a{length inp == len}) : + lseq a (len % blocksize) += + let rem = len % blocksize in + let b: lseq a rem = Seq.slice inp (len - rem) len in + b + + +val repeati_extensionality: + #a:Type0 + -> n:nat + -> f:(i:nat{i < n} -> a -> a) + -> g:(i:nat{i < n} -> a -> a) + -> acc0:a -> + Lemma + (requires (forall (i:nat{i < n}) (acc:a). f i acc == g i acc)) + (ensures Loops.repeati n f acc0 == Loops.repeati n g acc0) + + +val repeat_right_extensionality: + n:nat + -> lo:nat + -> a_f:(i:nat{lo <= i /\ i <= lo + n} -> Type) + -> a_g:(i:nat{lo <= i /\ i <= lo + n} -> Type) + -> f:(i:nat{lo <= i /\ i < lo + n} -> a_f i -> a_f (i + 1)) + -> g:(i:nat{lo <= i /\ i < lo + n} -> a_g i -> a_g (i + 1)) + -> acc0:a_f lo -> + Lemma + (requires + (forall (i:nat{lo <= i /\ i <= lo + n}). a_f i == a_g i) /\ + (forall (i:nat{lo <= i /\ i < lo + n}) (acc:a_f i). f i acc == g i acc)) + (ensures + Loops.repeat_right lo (lo + n) a_f f acc0 == + Loops.repeat_right lo (lo + n) a_g g acc0) + + +// Loops.repeat_gen n a_f f acc0 == +// Loops.repeat_right lo_g (lo_g + n) a_g g acc0) +val repeat_gen_right_extensionality: + n:nat + -> lo_g:nat + -> a_f:(i:nat{i <= n} -> Type) + -> a_g:(i:nat{lo_g <= i /\ i <= lo_g + n} -> Type) + -> f:(i:nat{i < n} -> a_f i -> a_f (i + 1)) + -> g:(i:nat{lo_g <= i /\ i < lo_g + n} -> a_g i -> a_g (i + 1)) + -> acc0:a_f 0 -> + Lemma + (requires + (forall (i:nat{i <= n}). a_f i == a_g (lo_g + i)) /\ + (forall (i:nat{i < n}) (acc:a_f i). f i acc == g (lo_g + i) acc)) + (ensures + Loops.repeat_right 0 n a_f f acc0 == + Loops.repeat_right lo_g (lo_g + n) a_g g acc0) + + +// Loops.repeati n a f acc0 == +// Loops.repeat_right lo_g (lo_g + n) (Loops.fixed_a a) g acc0 +val repeati_right_extensionality: + #a:Type + -> n:nat + -> lo_g:nat + -> f:(i:nat{i < n} -> a -> a) + -> g:(i:nat{lo_g <= i /\ i < lo_g + n} -> a -> a) + -> acc0:a -> + Lemma + (requires (forall (i:nat{i < n}) (acc:a). f i acc == g (lo_g + i) acc)) + (ensures + Loops.repeat_right 0 n (Loops.fixed_a a) f acc0 == + Loops.repeat_right lo_g (lo_g + n) (Loops.fixed_a a) g acc0) + +/// A specialized version of the lemma above, for only shifting one computation, +/// but specified using repeati instead +val repeati_right_shift: + #a:Type + -> n:nat + -> f:(i:nat{i < n} -> a -> a) + -> g:(i:nat{i < 1 + n} -> a -> a) + -> acc0:a -> + Lemma + (requires (forall (i:nat{i < n}) (acc:a). f i acc == g (i + 1) acc)) + (ensures Loops.repeati n f (g 0 acc0) == Loops.repeati (n + 1) g acc0) + +/// +/// `repeat_gen_blocks` is defined here to prove all the properties +/// needed for `map_blocks` and `repeat_blocks` once +/// + +let repeat_gen_blocks_f + (#inp_t:Type0) + (blocksize:size_pos) + (mi:nat) + (hi:nat) + (n:nat{mi + n <= hi}) + (inp:seq inp_t{length inp == n * blocksize}) + (a:(i:nat{i <= hi} -> Type)) + (f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1))) + (i:nat{mi <= i /\ i < mi + n}) + (acc:a i) : a (i + 1) += + let i_b = i - mi in + Math.Lemmas.lemma_mult_le_right blocksize (i_b + 1) n; + let block = Seq.slice inp (i_b * blocksize) (i_b * blocksize + blocksize) in + f i block acc + + +//lo = 0 +val repeat_gen_blocks_multi: + #inp_t:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> n:nat{mi + n <= hi} + -> inp:seq inp_t{length inp == n * blocksize} + -> a:(i:nat{i <= hi} -> Type) + -> f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> acc0:a mi -> + a (mi + n) + + +val lemma_repeat_gen_blocks_multi: + #inp_t:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> n:nat{mi + n <= hi} + -> inp:seq inp_t{length inp == n * blocksize} + -> a:(i:nat{i <= hi} -> Type) + -> f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> acc0:a mi -> + Lemma + (repeat_gen_blocks_multi #inp_t blocksize mi hi n inp a f acc0 == + Loops.repeat_right mi (mi + n) a (repeat_gen_blocks_f blocksize mi hi n inp a f) acc0) + + +val repeat_gen_blocks: + #inp_t:Type0 + -> #c:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> inp:seq inp_t{mi + length inp / blocksize <= hi} + -> a:(i:nat{i <= hi} -> Type) + -> f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> l:(i:nat{i <= hi} -> len:nat{len < blocksize} -> lseq inp_t len -> a i -> c) + -> acci:a mi -> + c + + +val lemma_repeat_gen_blocks: + #inp_t:Type0 + -> #c:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> inp:seq inp_t{mi + length inp / blocksize <= hi} + -> a:(i:nat{i <= hi} -> Type) + -> f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> l:(i:nat{i <= hi} -> len:nat{len < blocksize} -> lseq inp_t len -> a i -> c) + -> acc0:a mi -> + Lemma + (let len = length inp in + let nb = len / blocksize in + let rem = len % blocksize in + let blocks = Seq.slice inp 0 (nb * blocksize) in + let last = Seq.slice inp (nb * blocksize) len in + Math.Lemmas.cancel_mul_div nb blocksize; + Math.Lemmas.cancel_mul_mod nb blocksize; + let acc = repeat_gen_blocks_multi #inp_t blocksize mi hi nb blocks a f acc0 in + repeat_gen_blocks blocksize mi hi inp a f l acc0 == l (mi + nb) rem last acc) + + +val repeat_gen_blocks_multi_extensionality_zero: + #inp_t:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi_f:nat + -> hi_g:nat + -> n:nat{mi + n <= hi_f /\ n <= hi_g} + -> inp:seq inp_t{length inp == n * blocksize} + -> a_f:(i:nat{i <= hi_f} -> Type) + -> a_g:(i:nat{i <= hi_g} -> Type) + -> f:(i:nat{i < hi_f} -> lseq inp_t blocksize -> a_f i -> a_f (i + 1)) + -> g:(i:nat{i < hi_g} -> lseq inp_t blocksize -> a_g i -> a_g (i + 1)) + -> acc0:a_f mi -> + Lemma + (requires + (forall (i:nat{i <= n}). a_f (mi + i) == a_g i) /\ + (forall (i:nat{i < n}) (block:lseq inp_t blocksize) (acc:a_f (mi + i)). + f (mi + i) block acc == g i block acc)) + (ensures + repeat_gen_blocks_multi blocksize mi hi_f n inp a_f f acc0 == + repeat_gen_blocks_multi blocksize 0 hi_g n inp a_g g acc0) + + +val repeat_gen_blocks_extensionality_zero: + #inp_t:Type0 + -> #c:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi_f:nat + -> hi_g:nat + -> n:nat{mi + n <= hi_f /\ n <= hi_g} + -> inp:seq inp_t{n == length inp / blocksize} + -> a_f:(i:nat{i <= hi_f} -> Type) + -> a_g:(i:nat{i <= hi_g} -> Type) + -> f:(i:nat{i < hi_f} -> lseq inp_t blocksize -> a_f i -> a_f (i + 1)) + -> l_f:(i:nat{i <= hi_f} -> len:nat{len < blocksize} -> lseq inp_t len -> a_f i -> c) + -> g:(i:nat{i < hi_g} -> lseq inp_t blocksize -> a_g i -> a_g (i + 1)) + -> l_g:(i:nat{i <= hi_g} -> len:nat{len < blocksize} -> lseq inp_t len -> a_g i -> c) + -> acc0:a_f mi -> + Lemma + (requires + (forall (i:nat{i <= n}). a_f (mi + i) == a_g i) /\ + (forall (i:nat{i < n}) (block:lseq inp_t blocksize) (acc:a_f (mi + i)). + f (mi + i) block acc == g i block acc) /\ + (forall (i:nat{i <= n}) (len:nat{len < blocksize}) (block:lseq inp_t len) (acc:a_f (mi + i)). + l_f (mi + i) len block acc == l_g i len block acc)) + (ensures + repeat_gen_blocks blocksize mi hi_f inp a_f f l_f acc0 == + repeat_gen_blocks blocksize 0 hi_g inp a_g g l_g acc0) + + +val len0_div_bs: blocksize:pos -> len:nat -> len0:nat -> + Lemma + (requires len0 <= len /\ len0 % blocksize == 0) + (ensures len0 / blocksize + (len - len0) / blocksize == len / blocksize) + + +val split_len_lemma0: blocksize:pos -> n:nat -> len0:nat -> + Lemma + (requires len0 <= n * blocksize /\ len0 % blocksize = 0) + (ensures + (let len = n * blocksize in + let len1 = len - len0 in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + len % blocksize = 0 /\ len1 % blocksize = 0 /\ n0 + n1 = n /\ + n0 * blocksize = len0 /\ n1 * blocksize = len1)) + + +val split_len_lemma: blocksize:pos -> len:nat -> len0:nat -> + Lemma + (requires len0 <= len /\ len0 % blocksize = 0) + (ensures + (let len1 = len - len0 in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + let n = len / blocksize in + len % blocksize = len1 % blocksize /\ + n0 * blocksize = len0 /\ n0 + n1 = n)) + + +val repeat_gen_blocks_multi_split: + #inp_t:Type0 + -> blocksize:size_pos + -> len0:nat{len0 % blocksize == 0} + -> mi:nat + -> hi:nat + -> n:nat{mi + n <= hi} + -> inp:seq inp_t{len0 <= length inp /\ length inp == n * blocksize} + -> a:(i:nat{i <= hi} -> Type) + -> f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> acc0:a mi -> + Lemma + (let len = length inp in + let len1 = len - len0 in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + split_len_lemma0 blocksize n len0; + + let t0 = Seq.slice inp 0 len0 in + let t1 = Seq.slice inp len0 len in + + let acc : a (mi + n0) = repeat_gen_blocks_multi blocksize mi hi n0 t0 a f acc0 in + repeat_gen_blocks_multi blocksize mi hi n inp a f acc0 == + repeat_gen_blocks_multi blocksize (mi + n0) hi n1 t1 a f acc) + + +val repeat_gen_blocks_split: + #inp_t:Type0 + -> #c:Type0 + -> blocksize:size_pos + -> len0:nat{len0 % blocksize == 0} + -> hi:nat + -> mi:nat{mi <= hi} + -> inp:seq inp_t{len0 <= length inp /\ mi + length inp / blocksize <= hi} + -> a:(i:nat{i <= hi} -> Type) + -> f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> l:(i:nat{i <= hi} -> len:nat{len < blocksize} -> lseq inp_t len -> a i -> c) + -> acc0:a mi -> + Lemma + (let len = length inp in + let n = len / blocksize in + let n0 = len0 / blocksize in + split_len_lemma blocksize len len0; + + let t0 = Seq.slice inp 0 len0 in + let t1 = Seq.slice inp len0 len in + + let acc : a (mi + n0) = repeat_gen_blocks_multi blocksize mi hi n0 t0 a f acc0 in + repeat_gen_blocks blocksize mi hi inp a f l acc0 == + repeat_gen_blocks blocksize (mi + n0) hi t1 a f l acc) + +/// +/// Properties related to the repeat_blocks combinator +/// + +val repeat_blocks_extensionality: + #a:Type0 + -> #b:Type0 + -> #c:Type0 + -> blocksize:size_pos + -> inp:seq a + -> f1:(lseq a blocksize -> b -> b) + -> f2:(lseq a blocksize -> b -> b) + -> l1:(len:nat{len < blocksize} -> s:lseq a len -> b -> c) + -> l2:(len:nat{len < blocksize} -> s:lseq a len -> b -> c) + -> acc0:b -> + Lemma + (requires + (forall (block:lseq a blocksize) (acc:b). f1 block acc == f2 block acc) /\ + (forall (rem:nat{rem < blocksize}) (last:lseq a rem) (acc:b). l1 rem last acc == l2 rem last acc)) + (ensures + repeat_blocks blocksize inp f1 l1 acc0 == repeat_blocks blocksize inp f2 l2 acc0) + + +val lemma_repeat_blocks_via_multi: + #a:Type0 + -> #b:Type0 + -> #c:Type0 + -> blocksize:size_pos + -> inp:seq a + -> f:(lseq a blocksize -> b -> b) + -> l:(len:nat{len < blocksize} -> s:lseq a len -> b -> c) + -> acc0:b -> + Lemma + (let len = length inp in + let nb = len / blocksize in + let rem = len % blocksize in + let blocks = Seq.slice inp 0 (nb * blocksize) in + let last = Seq.slice inp (nb * blocksize) len in + Math.Lemmas.cancel_mul_mod nb blocksize; + let acc = repeat_blocks_multi blocksize blocks f acc0 in + repeat_blocks #a #b blocksize inp f l acc0 == l rem last acc) + + +val repeat_blocks_multi_is_repeat_gen_blocks_multi: + #a:Type0 + -> #b:Type0 + -> hi:nat + -> blocksize:size_pos + -> inp:seq a{length inp % blocksize = 0 /\ length inp / blocksize <= hi} + -> f:(lseq a blocksize -> b -> b) + -> acc0:b -> + Lemma + (let n = length inp / blocksize in + Math.Lemmas.div_exact_r (length inp) blocksize; + repeat_blocks_multi #a #b blocksize inp f acc0 == + repeat_gen_blocks_multi #a blocksize 0 hi n inp (Loops.fixed_a b) (Loops.fixed_i f) acc0) + + +val repeat_blocks_is_repeat_gen_blocks: + #a:Type0 + -> #b:Type0 + -> #c:Type0 + -> hi:nat + -> blocksize:size_pos + -> inp:seq a{length inp / blocksize <= hi} + -> f:(lseq a blocksize -> b -> b) + -> l:(len:nat{len < blocksize} -> s:lseq a len -> b -> c) + -> acc0:b -> + Lemma + (repeat_blocks #a #b #c blocksize inp f l acc0 == + repeat_gen_blocks #a #c blocksize 0 hi inp + (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i l) acc0) + + +val repeat_blocks_multi_split: + #a:Type0 + -> #b:Type0 + -> blocksize:size_pos + -> len0:nat{len0 % blocksize = 0} + -> inp:seq a{len0 <= length inp /\ length inp % blocksize = 0} + -> f:(lseq a blocksize -> b -> b) + -> acc0:b -> + Lemma + (let len = length inp in + Math.Lemmas.lemma_div_exact len blocksize; + split_len_lemma0 blocksize (len / blocksize) len0; + Math.Lemmas.swap_mul blocksize (len / blocksize); + + repeat_blocks_multi blocksize inp f acc0 == + repeat_blocks_multi blocksize (Seq.slice inp len0 len) f + (repeat_blocks_multi blocksize (Seq.slice inp 0 len0) f acc0)) + + +val repeat_blocks_split: + #a:Type0 + -> #b:Type0 + -> #c:Type0 + -> blocksize:size_pos + -> len0:nat{len0 % blocksize = 0} + -> inp:seq a{len0 <= length inp} + -> f:(lseq a blocksize -> b -> b) + -> l:(len:nat{len < blocksize} -> s:lseq a len -> b -> c) + -> acc0:b -> + Lemma + (let len = length inp in + split_len_lemma blocksize len len0; + + repeat_blocks blocksize inp f l acc0 == + repeat_blocks blocksize (Seq.slice inp len0 len) f l + (repeat_blocks_multi blocksize (Seq.slice inp 0 len0) f acc0)) + +/// +val repeat_blocks_multi_extensionality: + #a:Type0 + -> #b:Type0 + -> blocksize:size_pos + -> inp:seq a{length inp % blocksize = 0} + -> f:(lseq a blocksize -> b -> b) + -> g:(lseq a blocksize -> b -> b) + -> init:b -> + Lemma + (requires + (forall (block:lseq a blocksize) (acc:b). f block acc == g block acc)) + (ensures + repeat_blocks_multi blocksize inp f init == + repeat_blocks_multi blocksize inp g init) + +/// Properties related to the map_blocks combinator +/// + +val map_blocks_multi_extensionality: + #a:Type0 + -> blocksize:size_pos + -> max:nat + -> n:nat{n <= max} + -> inp:seq a{length inp == max * blocksize} + -> f:(i:nat{i < max} -> lseq a blocksize -> lseq a blocksize) + -> g:(i:nat{i < max} -> lseq a blocksize -> lseq a blocksize) -> + Lemma + (requires + (forall (i:nat{i < max}) (b_v:lseq a blocksize). f i b_v == g i b_v)) + (ensures + map_blocks_multi blocksize max n inp f == + map_blocks_multi blocksize max n inp g) + + +val map_blocks_extensionality: + #a:Type0 + -> blocksize:size_pos + -> inp:seq a + -> f:(block (length inp) blocksize -> lseq a blocksize -> lseq a blocksize) + -> l_f:(last (length inp) blocksize -> rem:size_nat{rem < blocksize} -> s:lseq a rem -> lseq a rem) + -> g:(block (length inp) blocksize -> lseq a blocksize -> lseq a blocksize) + -> l_g:(last (length inp) blocksize -> rem:size_nat{rem < blocksize} -> s:lseq a rem -> lseq a rem) -> + Lemma + (requires + (let n = length inp / blocksize in + (forall (i:nat{i < n}) (b_v:lseq a blocksize). f i b_v == g i b_v) /\ + (forall (rem:nat{rem < blocksize}) (b_v:lseq a rem). l_f n rem b_v == l_g n rem b_v))) + (ensures + map_blocks blocksize inp f l_f == map_blocks blocksize inp g l_g) + +/// +/// New definition of `map_blocks` that takes extra parameter `acc`. +/// When `acc` = Seq.empty, map_blocks == map_blocks_acc +/// + +let repeat_gen_blocks_map_f + (#a:Type0) + (blocksize:size_pos) + (hi:nat) + (f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize)) + (i:nat{i < hi}) + (block:lseq a blocksize) + (acc:map_blocks_a a blocksize hi i) : map_blocks_a a blocksize hi (i + 1) + = + Seq.append acc (f i block) + + +let repeat_gen_blocks_map_l + (#a:Type0) + (blocksize:size_pos) + (hi:nat) + (l:(i:nat{i <= hi} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem)) + (i:nat{i <= hi}) + (rem:nat{rem < blocksize}) + (block_l:lseq a rem) + (acc:map_blocks_a a blocksize hi i) : seq a + = + if rem > 0 then Seq.append acc (l i rem block_l) else acc + + +val repeat_gen_blocks_map_l_length: + #a:Type0 + -> blocksize:size_pos + -> hi:nat + -> l:(i:nat{i <= hi} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> i:nat{i <= hi} + -> rem:nat{rem < blocksize} + -> block_l:lseq a rem + -> acc:map_blocks_a a blocksize hi i -> + Lemma (length (repeat_gen_blocks_map_l blocksize hi l i rem block_l acc) == i * blocksize + rem) + + +val map_blocks_multi_acc: + #a:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> n:nat{mi + n <= hi} + -> inp:seq a{length inp == n * blocksize} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> acc0:map_blocks_a a blocksize hi mi -> + out:seq a {length out == length acc0 + length inp} + + +val map_blocks_acc: + #a:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> inp:seq a{mi + length inp / blocksize <= hi} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= hi} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> acc0:map_blocks_a a blocksize hi mi -> + seq a + + +val map_blocks_acc_length: + #a:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> inp:seq a{mi + length inp / blocksize <= hi} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= hi} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> acc0:map_blocks_a a blocksize hi mi -> + Lemma (length (map_blocks_acc blocksize mi hi inp f l acc0) == length acc0 + length inp) + [SMTPat (map_blocks_acc blocksize mi hi inp f l acc0)] + + +val map_blocks_multi_acc_is_repeat_gen_blocks_multi: + #a:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> n:nat{mi + n <= hi} + -> inp:seq a{length inp == n * blocksize} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> acc0:map_blocks_a a blocksize hi mi -> + Lemma + (map_blocks_multi_acc #a blocksize mi hi n inp f acc0 == + repeat_gen_blocks_multi #a blocksize mi hi n inp + (map_blocks_a a blocksize hi) + (repeat_gen_blocks_map_f blocksize hi f) acc0) + + +val map_blocks_acc_is_repeat_gen_blocks: + #a:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> inp:seq a{mi + length inp / blocksize <= hi} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= hi} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> acc0:map_blocks_a a blocksize hi mi -> + Lemma + (map_blocks_acc #a blocksize mi hi inp f l acc0 == + repeat_gen_blocks #a blocksize mi hi inp + (map_blocks_a a blocksize hi) + (repeat_gen_blocks_map_f blocksize hi f) + (repeat_gen_blocks_map_l blocksize hi l) acc0) + + +let f_shift (#a:Type0) (blocksize:size_pos) (mi:nat) (hi:nat) (n:nat{mi + n <= hi}) + (f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize)) (i:nat{i < n}) = f (mi + i) + + +let l_shift (#a:Type0) (blocksize:size_pos) (mi:nat) (hi:nat) (n:nat{mi + n <= hi}) + (l:(i:nat{i <= hi} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem)) (i:nat{i <= n}) = l (mi + i) + + +val map_blocks_multi_acc_is_map_blocks_multi: + #a:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> n:nat{mi + n <= hi} + -> inp:seq a{length inp == n * blocksize} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> acc0:map_blocks_a a blocksize hi mi -> + Lemma + (map_blocks_multi_acc blocksize mi hi n inp f acc0 `Seq.equal` + Seq.append acc0 (map_blocks_multi blocksize n n inp (f_shift blocksize mi hi n f))) + + +val map_blocks_acc_is_map_blocks: + #a:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> inp:seq a{mi + length inp / blocksize <= hi} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= hi} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> acc0:map_blocks_a a blocksize hi mi -> + Lemma + (let n = length inp / blocksize in + map_blocks_acc #a blocksize mi hi inp f l acc0 `Seq.equal` + Seq.append acc0 (map_blocks #a blocksize inp (f_shift blocksize mi hi n f) (l_shift blocksize mi hi n l))) + + +val map_blocks_multi_acc_is_map_blocks_multi0: + #a:Type0 + -> blocksize:size_pos + -> hi:nat + -> n:nat{n <= hi} + -> inp:seq a{length inp == n * blocksize} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) -> + Lemma (map_blocks_multi_acc blocksize 0 hi n inp f Seq.empty `Seq.equal` map_blocks_multi blocksize n n inp f) + + +val map_blocks_acc_is_map_blocks0: + #a:Type0 + -> blocksize:size_pos + -> hi:nat + -> inp:seq a{length inp / blocksize <= hi} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= hi} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) -> + Lemma (map_blocks_acc #a blocksize 0 hi inp f l Seq.empty `Seq.equal` map_blocks #a blocksize inp f l) + + +val map_blocks_is_empty: + #a:Type0 + -> blocksize:size_pos + -> hi:nat + -> inp:seq a{length inp == 0} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= hi} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) -> + Lemma (map_blocks #a blocksize inp f l == Seq.empty) + + +(* +//Now it's possible to prove the following lemma: + +val map_blocks_multi_split: + #a:Type0 + -> blocksize:size_pos + -> len0:nat{len0 % blocksize = 0} + -> hi:nat + -> mi:nat + -> n:nat{mi + n <= hi} + -> inp:seq a{len0 <= length inp /\ length inp == n * blocksize} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> acc:map_blocks_a a blocksize hi mi -> + Lemma + (let len = length inp in + let len1 = len - len0 in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + split_len_lemma0 blocksize n len0; + + let t0 = Seq.slice inp 0 len0 in + let t1 = Seq.slice inp len0 len in + + map_blocks_multi_acc blocksize mi hi n inp f acc == + map_blocks_multi_acc blocksize (mi + n0) hi n1 t1 f + (map_blocks_multi_acc blocksize mi hi n0 t0 f acc)) +*) diff --git a/tests/hacl/Lib.Sequence.fsti b/tests/hacl/Lib.Sequence.fsti new file mode 100644 index 00000000000..d3e0b95d032 --- /dev/null +++ b/tests/hacl/Lib.Sequence.fsti @@ -0,0 +1,612 @@ +module Lib.Sequence + +open FStar.Mul +open Lib.IntTypes + +#set-options "--z3rlimit 30 --max_fuel 0 --max_ifuel 0 --using_facts_from '-* +Prims +FStar.Math.Lemmas +FStar.Seq +Lib.IntTypes +Lib.Sequence'" + +/// Variable length Sequences, derived from FStar.Seq + +(* This is the type of unbounded sequences. + Use this only when dealing with, say, user input whose length is unbounded. + As far as possible use the API for bounded sequences defined later in this file.*) + +(** Definition of a Sequence *) +let seq (a:Type0) = Seq.seq a + +(** Length of a Sequence *) +let length (#a:Type0) (s:seq a) : nat = Seq.length s + +/// Fixed length Sequences + +(* This is the type of bounded sequences. + Use this as much as possible. + It adds additional length checks that you'd have to prove in the implementation otherwise *) + +(** Definition of a fixed-length Sequence *) +let lseq (a:Type0) (len:size_nat) = s:seq a{Seq.length s == len} +let to_seq (#a:Type0) (#len:size_nat) (l:lseq a len) : seq a = l +let to_lseq (#a:Type0) (s:seq a{length s <= max_size_t}) : l:lseq a (length s){l == s} = s + +(* If you want to prove your code with an abstract lseq use the following: *) +// val lseq: a:Type0 -> len:size_nat -> Type0 +// val to_seq: #a:Type0 -> #len:size_nat -> lseq a len -> s:seq a{length s == len} +// val to_lseq: #a:Type0 -> s:seq a{length s <= max_size_t} -> lseq a (length s) + +val index: + #a:Type + -> #len:size_nat + -> s:lseq a len + -> i:size_nat{i < len} -> + Tot (r:a{r == Seq.index (to_seq s) i}) + +(** Creation of a fixed-length Sequence from an initial value *) +val create: + #a:Type + -> len:size_nat + -> init:a -> + Tot (s:lseq a len{to_seq s == Seq.create len init /\ (forall (i:nat). + {:pattern (index s i)} i < len ==> index s i == init)}) + + +(** Concatenate sequences: use with care, may make implementation hard to verify *) +val concat: + #a:Type + -> #len0:size_nat + -> #len1:size_nat{len0 + len1 <= max_size_t} + -> s0:lseq a len0 + -> s1:lseq a len1 -> + Tot (s2:lseq a (len0 + len1){to_seq s2 == Seq.append (to_seq s0) (to_seq s1)}) + +let ( @| ) #a #len0 #len1 s0 s1 = concat #a #len0 #len1 s0 s1 + + +(** Conversion of a Sequence to a list *) +val to_list: + #a:Type + -> s:seq a -> + Tot (l:list a{List.Tot.length l = length s /\ l == Seq.seq_to_list s}) + +(** Creation of a fixed-length Sequence from a list of values *) +val of_list: + #a:Type + -> l:list a{List.Tot.length l <= max_size_t} -> + Tot (s:lseq a (List.Tot.length l){to_seq s == Seq.seq_of_list l}) + +val of_list_index: + #a:Type + -> l:list a{List.Tot.length l <= max_size_t} + -> i:nat{i < List.Tot.length l} -> + Lemma (index (of_list l) i == List.Tot.index l i) + [SMTPat (index (of_list l) i)] + +val equal (#a:Type) (#len:size_nat) (s1:lseq a len) (s2:lseq a len) : Type0 + +val eq_intro: #a:Type -> #len:size_nat -> s1:lseq a len -> s2:lseq a len -> + Lemma + (requires forall i. {:pattern index s1 i; index s2 i} index s1 i == index s2 i) + (ensures equal s1 s2) + [SMTPat (equal s1 s2)] + +val eq_elim: #a:Type -> #len:size_nat -> s1:lseq a len -> s2:lseq a len -> + Lemma + (requires equal s1 s2) + (ensures s1 == s2) + [SMTPat (equal s1 s2)] + +(* Alias for creation from a list *) +unfold let createL #a l = of_list #a l + +(** Updating an element of a fixed-length Sequence *) +val upd: + #a:Type + -> #len:size_nat + -> s:lseq a len + -> n:size_nat{n < len} + -> x:a -> + Tot (o:lseq a len{to_seq o == Seq.upd (to_seq s) n x /\ index o n == x /\ (forall (i:size_nat). + {:pattern (index s i)} (i < len /\ i <> n) ==> index o i == index s i)}) + +(** Membership of an element to a fixed-length Sequence *) +val member: #a:eqtype -> #len: size_nat -> a -> lseq a len -> Tot bool + +(** Operator for accessing an element of a fixed-length Sequence *) +unfold +let op_String_Access #a #len = index #a #len + +(** Operator for updating an element of a fixed-length Sequence *) +unfold +let op_String_Assignment #a #len = upd #a #len + +(** Selecting a subset of a fixed-length Sequence *) +val sub: + #a:Type + -> #len:size_nat + -> s1:lseq a len + -> start:size_nat + -> n:size_nat{start + n <= len} -> + Tot (s2:lseq a n{to_seq s2 == Seq.slice (to_seq s1) start (start + n) /\ + (forall (k:nat{k < n}). {:pattern (index s2 k)} index s2 k == index s1 (start + k))}) + +(** Selecting a subset of a fixed-length Sequence *) +let slice + (#a:Type) + (#len:size_nat) + (s1:lseq a len) + (start:size_nat) + (fin:size_nat{start <= fin /\ fin <= len}) + = + sub #a s1 start (fin - start) + +(** Updating a sub-Sequence from another fixed-length Sequence *) +val update_sub: + #a:Type + -> #len:size_nat + -> i:lseq a len + -> start:size_nat + -> n:size_nat{start + n <= len} + -> x:lseq a n -> + Tot (o:lseq a len{sub o start n == x /\ + (forall (k:nat{(0 <= k /\ k < start) \/ (start + n <= k /\ k < len)}). + {:pattern (index o k)} index o k == index i k)}) + +(** Lemma regarding updating a sub-Sequence with another Sequence *) +val lemma_update_sub: + #a:Type + -> #len:size_nat + -> dst:lseq a len + -> start:size_nat + -> n:size_nat{start + n <= len} + -> src:lseq a n + -> res:lseq a len -> + Lemma + (requires + sub res 0 start == sub dst 0 start /\ + sub res start n == src /\ + sub res (start + n) (len - start - n) == + sub dst (start + n) (len - start - n)) + (ensures + res == update_sub dst start n src) + +val lemma_concat2: + #a:Type0 + -> len0:size_nat + -> s0:lseq a len0 + -> len1:size_nat{len0 + len1 <= max_size_t} + -> s1:lseq a len1 + -> s:lseq a (len0 + len1) -> + Lemma + (requires + sub s 0 len0 == s0 /\ + sub s len0 len1 == s1) + (ensures s == concat s0 s1) + +val lemma_concat3: + #a:Type0 + -> len0:size_nat + -> s0:lseq a len0 + -> len1:size_nat{len0 + len1 <= max_size_t} + -> s1:lseq a len1 + -> len2:size_nat{len0 + len1 + len2 <= max_size_t} + -> s2:lseq a len2 + -> s:lseq a (len0 + len1 + len2) -> + Lemma + (requires + sub s 0 len0 == s0 /\ + sub s len0 len1 == s1 /\ + sub s (len0 + len1) len2 == s2) + (ensures s == concat (concat s0 s1) s2) + +(** Updating a sub-Sequence from another fixed-length Sequence *) +let update_slice + (#a:Type) + (#len:size_nat) + (i:lseq a len) + (start:size_nat) + (fin:size_nat{start <= fin /\ fin <= len}) + (upd:lseq a (fin - start)) + = + update_sub #a i start (fin - start) upd + +(** Creation of a fixed-length Sequence from an initialization function *) +val createi: #a:Type + -> len:size_nat + -> init:(i:nat{i < len} -> a) -> + Tot (s:lseq a len{(forall (i:nat). + {:pattern (index s i)} i < len ==> index s i == init i)}) + +(** Mapi function for fixed-length Sequences *) +val mapi:#a:Type -> #b:Type -> #len:size_nat + -> f:(i:nat{i < len} -> a -> Tot b) + -> s1:lseq a len -> + Tot (s2:lseq b len{(forall (i:nat). + {:pattern (index s2 i)} i < len ==> index s2 i == f i s1.[i])}) + +(** Map function for fixed-length Sequences *) +val map:#a:Type -> #b:Type -> #len:size_nat + -> f:(a -> Tot b) + -> s1:lseq a len -> + Tot (s2:lseq b len{(forall (i:nat). + {:pattern (index s2 i)} i < len ==> index s2 i == f s1.[i])}) + +(** Map2i function for fixed-length Sequences *) +val map2i:#a:Type -> #b:Type -> #c:Type -> #len:size_nat + -> f:(i:nat{i < len} -> a -> b -> Tot c) + -> s1:lseq a len + -> s2:lseq b len -> + Tot (s3:lseq c len{(forall (i:nat). + {:pattern (index s3 i)} i < len ==> index s3 i == f i s1.[i] s2.[i])}) + +(** Map2 function for fixed-length Sequences *) +val map2:#a:Type -> #b:Type -> #c:Type -> #len:size_nat + -> f:(a -> b -> Tot c) + -> s1:lseq a len + -> s2:lseq b len -> + Tot (s3:lseq c len{(forall (i:nat). + {:pattern (index s3 i)} i < len ==> index s3 i == f s1.[i] s2.[i])}) + +(** Forall function for fixed-length Sequences *) +val for_all:#a:Type -> #len:size_nat -> (a -> Tot bool) -> lseq a len -> bool + +(** Forall2 function for fixed-length Sequences *) +val for_all2:#a:Type -> #b:Type -> #len:size_nat + -> (a -> b -> Tot bool) + -> s1:lseq a len + -> s2:lseq b len -> + Tot bool + +val repeati_blocks: + #a:Type0 + -> #b:Type0 + -> blocksize:size_pos + -> inp:seq a + -> f:(i:nat{i < length inp / blocksize} -> lseq a blocksize -> b -> b) + -> l:(i:nat{i == length inp / blocksize} -> len:size_nat{len == length inp % blocksize} -> s:lseq a len -> b -> b) + -> init:b -> + Tot b + +let repeat_blocks_f + (#a:Type0) + (#b:Type0) + (bs:size_nat{bs > 0}) + (inp:seq a) + (f:(lseq a bs -> b -> b)) + (nb:nat{nb == length inp / bs}) + (i:nat{i < nb}) + (acc:b) : b + = + assert ((i+1) * bs <= nb * bs); + let block = Seq.slice inp (i * bs) (i * bs + bs) in + f block acc + +val repeat_blocks: + #a:Type0 + -> #b:Type0 + -> #c:Type0 + -> blocksize:size_pos + -> inp:seq a + -> f:(lseq a blocksize -> b -> b) + -> l:(len:nat{len < blocksize} -> s:lseq a len -> b -> c) + -> init:b -> + Tot c + +val lemma_repeat_blocks: + #a:Type0 + -> #b:Type0 + -> #c:Type0 + -> bs:size_pos + -> inp:seq a + -> f:(lseq a bs -> b -> b) + -> l:(len:nat{len < bs} -> s:lseq a len -> b -> c) + -> init:b -> + Lemma ( + let len = length inp in + let nb = len / bs in + let rem = len % bs in + let acc = Lib.LoopCombinators.repeati nb (repeat_blocks_f bs inp f nb) init in + let last = Seq.slice inp (nb * bs) len in + let acc = l rem last acc in + repeat_blocks #a #b bs inp f l init == acc) + +val repeat_blocks_multi: + #a:Type0 + -> #b:Type0 + -> blocksize:size_pos + -> inp:seq a{length inp % blocksize = 0} + -> f:(lseq a blocksize -> b -> b) + -> init:b -> + Tot b + +val lemma_repeat_blocks_multi: + #a:Type0 + -> #b:Type0 + -> bs:size_pos + -> inp:seq a{length inp % bs = 0} + -> f:(lseq a bs -> b -> b) + -> init:b -> + Lemma ( + let len = length inp in + let nb = len / bs in + repeat_blocks_multi #a #b bs inp f init == + Lib.LoopCombinators.repeati nb (repeat_blocks_f bs inp f nb) init) + +(** Generates `n` blocks of length `len` by iteratively applying a function with an accumulator *) +val generate_blocks: + #t:Type0 + -> len:size_nat + -> max:nat + -> n:nat{n <= max} + -> a:(i:nat{i <= max} -> Type) + -> f:(i:nat{i < max} -> a i -> a (i + 1) & s:seq t{length s == len}) + -> init:a 0 -> + Tot (a n & s:seq t{length s == n * len}) + +(** Generates `n` blocks of length `len` by iteratively applying a function without an accumulator *) + +val generate_blocks_simple: + #a:Type0 + -> blocksize:size_pos + -> max:nat + -> n:nat{n <= max} + -> f:(i:nat{i < max} -> lseq a blocksize) -> + Tot (s:seq a{length s == n * blocksize}) + +(** The following functions allow us to bridge between unbounded and bounded sequences *) + + +val div_interval: b:pos -> n:int -> i:int -> Lemma + (requires n * b <= i /\ i < (n + 1) * b) + (ensures i / b = n) + +val mod_interval_lt: b:pos -> n:int -> i:int -> j:int -> Lemma + (requires n * b <= i /\ i < j /\ j < (n + 1) * b) + (ensures i % b < j % b) + +val div_mul_lt: b:pos -> a:int -> n:int -> Lemma + (requires a < n * b) + (ensures a / b < n) + +val mod_div_lt: b:pos -> i:int -> j:int -> Lemma + (requires (j / b) * b <= i /\ i < j) + (ensures i % b < j % b) + +val div_mul_l: a:int -> b:int -> c:pos -> d:pos -> Lemma + (requires a / d = b / d) + (ensures a / (c * d) = b / (c * d)) + + +let map_blocks_a (a:Type) (bs:size_nat) (max:nat) (i:nat{i <= max}) = s:seq a{length s == i * bs} + +let map_blocks_f + (#a:Type) + (bs:size_nat{bs > 0}) + (max:nat) + (inp:seq a{length inp == max * bs}) + (f:(i:nat{i < max} -> lseq a bs -> lseq a bs)) + (i:nat{i < max}) + (acc:map_blocks_a a bs max i) : map_blocks_a a bs max (i + 1) += + Math.Lemmas.lemma_mult_le_right bs (i+1) max; + let block = Seq.slice inp (i*bs) ((i+1)*bs) in + Seq.append acc (f i block) + + +val map_blocks_multi: + #a:Type0 + -> blocksize:size_pos + -> max:nat + -> n:nat{n <= max} + -> inp:seq a{length inp == max * blocksize} + -> f:(i:nat{i < max} -> lseq a blocksize -> lseq a blocksize) -> + Tot (out:seq a {length out == n * blocksize}) + + +val lemma_map_blocks_multi: + #a:Type0 + -> blocksize:size_pos + -> max:nat + -> n:nat{n <= max} + -> inp:seq a{length inp == max * blocksize} + -> f:(i:nat{i < max} -> lseq a blocksize -> lseq a blocksize) + -> Lemma + (map_blocks_multi #a blocksize max n inp f == + LoopCombinators.repeat_gen n (map_blocks_a a blocksize max) (map_blocks_f #a blocksize max inp f) Seq.empty) + + +#restart-solver +val index_map_blocks_multi: + #a:Type0 + -> bs:size_pos + -> max:pos + -> n:pos{n <= max} + -> inp:seq a{length inp == max * bs} + -> f:(i:nat{i < max} -> lseq a bs -> lseq a bs) + -> i:nat{i < n * bs} + -> Lemma ( + div_mul_lt bs i n; + let j = i / bs in + let block: lseq a bs = Seq.slice inp (j * bs) ((j + 1) * bs) in + Seq.index (map_blocks_multi bs max n inp f) i == Seq.index (f j block) (i % bs)) + +(* A full block index *) +unfold +let block (len:nat) (blocksize:size_pos) = i:nat{i < len / blocksize} + +(* Index of last (incomplete) block *) +unfold +let last (len:nat) (blocksize:size_pos) = i:nat{i = len / blocksize} + +val map_blocks: + #a:Type0 + -> blocksize:size_pos + -> inp:seq a + -> f:(block (length inp) blocksize -> lseq a blocksize -> lseq a blocksize) + -> g:(last (length inp) blocksize -> rem:size_nat{rem < blocksize} -> s:lseq a rem -> lseq a rem) -> + Tot (out:seq a{length out == length inp}) + +val lemma_map_blocks: + #a:Type0 + -> blocksize:size_pos + -> inp:seq a + -> f:(block (length inp) blocksize -> lseq a blocksize -> lseq a blocksize) + -> g:(last (length inp) blocksize -> rem:size_nat{rem < blocksize} -> s:lseq a rem -> lseq a rem) -> + Lemma ( + let len = length inp in + let nb = len / blocksize in + let rem = len % blocksize in + let blocks = Seq.slice inp 0 (nb * blocksize) in + let last = Seq.slice inp (nb * blocksize) len in + Math.Lemmas.cancel_mul_div nb blocksize; + let bs = map_blocks_multi #a blocksize nb nb blocks f in + let res = if (rem > 0) then Seq.append bs (g nb rem last) else bs in + res == map_blocks #a blocksize inp f g) + + +(* Computes the block of the i-th element of (map_blocks blocksize input f g) *) +let get_block + (#a:Type) + (#len:nat) + (blocksize:size_pos) + (inp:seq a{length inp == len}) + (f:(block len blocksize -> lseq a blocksize -> lseq a blocksize)) + (i:nat{i < (len / blocksize) * blocksize}) : + Pure (lseq a blocksize) True (fun _ -> i / blocksize < len / blocksize) += + div_mul_lt blocksize i (len / blocksize); + let j: block len blocksize = i / blocksize in + let b: lseq a blocksize = Seq.slice inp (j * blocksize) ((j + 1) * blocksize) in + f j b + + +(* Computes the last block of (map_blocks blocksize input f g) *) +let get_last + (#a:Type) + (#len:nat) + (blocksize:size_pos) + (inp:seq a{length inp == len}) + (g:(last len blocksize -> rem:size_nat{rem < blocksize} -> lseq a rem -> lseq a rem)) + (i:nat{(len / blocksize) * blocksize <= i /\ i < len}) : + Pure (lseq a (len % blocksize)) True (fun _ -> i % blocksize < len % blocksize) += + mod_div_lt blocksize i len; + let rem = len % blocksize in + let b: lseq a rem = Seq.slice inp (len - rem) len in + g (len / blocksize) rem b + + +val index_map_blocks: + #a:Type + -> blocksize:size_pos + -> inp:seq a + -> f:(block (length inp) blocksize -> lseq a blocksize -> lseq a blocksize) + -> g:(last (length inp) blocksize -> rem:size_nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> i:nat{i < length inp} -> + Lemma ( + let output = map_blocks blocksize inp f g in + let j = i % blocksize in + if i < (length inp / blocksize) * blocksize + then + let block_i = get_block blocksize inp f i in + Seq.index output i == Seq.index block_i j + else + let block_i = get_last blocksize inp g i in + Seq.index output i == Seq.index block_i j + ) + + +val eq_generate_blocks0: + #t:Type0 + -> len:size_nat + -> n:nat + -> a:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < n} -> a i -> a (i + 1) & s:seq t{length s == len}) + -> init:a 0 -> + Lemma (generate_blocks #t len n 0 a f init == + (init,Seq.empty)) + +val unfold_generate_blocks: + #t:Type0 + -> len:size_nat + -> n:nat + -> a:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < n} -> a i -> a (i + 1) & s:seq t{length s == len}) + -> init:a 0 + -> i:nat{i < n} -> + Lemma (generate_blocks #t len n (i+1) a f init == + (let (acc,s) = generate_blocks #t len n i a f init in + let (acc',s') = f i acc in + (acc',Seq.append s s'))) + +val index_generate_blocks: + #t:Type0 + -> len:size_pos + -> max:nat + -> n:pos{n <= max} + -> f:(i:nat{i < max} -> unit -> unit & s:seq t{length s == len}) + -> i:nat{i < n * len} + -> Lemma (Math.Lemmas.lemma_mult_le_right len n max; + div_mul_lt len i max; + let a_spec (i:nat{i <= max}) = unit in + let _,s1 = generate_blocks len max n a_spec f () in + let _,s2 = f (i / len) () in + Seq.index s1 i == Seq.index s2 (i % len)) + +#push-options "--using_facts_from '+FStar.UInt.pow2_values'" + +val create2: #a:Type -> x0:a -> x1:a -> lseq a 2 + +val create2_lemma: #a:Type -> x0:a -> x1:a -> + Lemma (let s = create2 x0 x1 in + s.[0] == x0 /\ s.[1] == x1) + [SMTPat (create2 #a x0 x1)] + +val create4: #a:Type -> x0:a -> x1:a -> x2:a -> x3:a -> lseq a 4 + +val create4_lemma: #a:Type -> x0:a -> x1:a -> x2:a -> x3:a -> + Lemma (let s = create4 x0 x1 x2 x3 in + s.[0] == x0 /\ s.[1] == x1 /\ s.[2] == x2 /\ s.[3] == x3) + [SMTPat (create4 #a x0 x1 x2 x3)] + +val create8: #a:Type -> x0:a -> x1:a -> x2:a -> x3:a -> x4:a -> x5:a -> x6:a -> x7:a -> lseq a 8 + +val create8_lemma: #a:Type -> x0:a -> x1:a -> x2:a -> x3:a -> x4:a -> x5:a -> x6:a -> x7:a -> + Lemma (let s = create8 x0 x1 x2 x3 x4 x5 x6 x7 in + s.[0] == x0 /\ s.[1] == x1 /\ s.[2] == x2 /\ s.[3] == x3 /\ + s.[4] == x4 /\ s.[5] == x5 /\ s.[6] == x6 /\ s.[7] == x7) + [SMTPat (create8 #a x0 x1 x2 x3 x4 x5 x6 x7)] + +val create16: #a:Type + -> x0:a -> x1:a -> x2:a -> x3:a -> x4:a -> x5:a -> x6:a -> x7:a + -> x8:a -> x9:a -> x10:a -> x11:a -> x12:a -> x13:a -> x14:a -> x15:a -> lseq a 16 + +val create16_lemma: #a:Type + -> x0:a -> x1:a -> x2:a -> x3:a -> x4:a -> x5:a -> x6:a -> x7:a + -> x8:a -> x9:a -> x10:a -> x11:a -> x12:a -> x13:a -> x14:a -> x15:a -> + Lemma (let s = create16 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 in + s.[0] == x0 /\ s.[1] == x1 /\ s.[2] == x2 /\ s.[3] == x3 /\ + s.[4] == x4 /\ s.[5] == x5 /\ s.[6] == x6 /\ s.[7] == x7 /\ + s.[8] == x8 /\ s.[9] == x9 /\ s.[10] == x10 /\ s.[11] == x11 /\ + s.[12] == x12 /\ s.[13] == x13 /\ s.[14] == x14 /\ s.[15] == x15) + [SMTPat (create16 #a x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15)] + +val create32: #a:Type + -> x0:a -> x1:a -> x2:a -> x3:a -> x4:a -> x5:a -> x6:a -> x7:a + -> x8:a -> x9:a -> x10:a -> x11:a -> x12:a -> x13:a -> x14:a -> x15:a + -> x16:a -> x17:a -> x18:a -> x19:a -> x20:a -> x21:a -> x22:a -> x23:a + -> x24:a -> x25:a -> x26:a -> x27:a -> x28:a -> x29:a -> x30:a -> x31:a -> lseq a 32 + +val create32_lemma: #a:Type + -> x0:a -> x1:a -> x2:a -> x3:a -> x4:a -> x5:a -> x6:a -> x7:a + -> x8:a -> x9:a -> x10:a -> x11:a -> x12:a -> x13:a -> x14:a -> x15:a + -> x16:a -> x17:a -> x18:a -> x19:a -> x20:a -> x21:a -> x22:a -> x23:a + -> x24:a -> x25:a -> x26:a -> x27:a -> x28:a -> x29:a -> x30:a -> x31:a -> + Lemma (let s = create32 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29 x30 x31 in + s.[0] == x0 /\ s.[1] == x1 /\ s.[2] == x2 /\ s.[3] == x3 /\ + s.[4] == x4 /\ s.[5] == x5 /\ s.[6] == x6 /\ s.[7] == x7 /\ + s.[8] == x8 /\ s.[9] == x9 /\ s.[10] == x10 /\ s.[11] == x11 /\ + s.[12] == x12 /\ s.[13] == x13 /\ s.[14] == x14 /\ s.[15] == x15 /\ + s.[16] == x16 /\ s.[17] == x17 /\ s.[18] == x18 /\ s.[19] == x19 /\ + s.[20] == x20 /\ s.[21] == x21 /\ s.[22] == x22 /\ s.[23] == x23 /\ + s.[24] == x24 /\ s.[25] == x25 /\ s.[26] == x26 /\ s.[27] == x27 /\ + s.[28] == x28 /\ s.[29] == x29 /\ s.[30] == x30 /\ s.[31] == x31) + [SMTPat (create32 #a x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29 x30 x31)] diff --git a/tests/hacl/Lib.Vec.Lemmas.fst b/tests/hacl/Lib.Vec.Lemmas.fst new file mode 100644 index 00000000000..bde6bd5a505 --- /dev/null +++ b/tests/hacl/Lib.Vec.Lemmas.fst @@ -0,0 +1,741 @@ +module Lib.Vec.Lemmas + +#set-options "" +#push-options "--z3rlimit 30 --max_fuel 0 --max_ifuel 0 \ + --using_facts_from '-* +Prims +FStar.Pervasives +FStar.Math.Lemmas +FStar.Seq -FStar.Seq.Properties.slice_slice \ + +Lib.IntTypes +Lib.Sequence +Lib.Sequence.Lemmas +Lib.LoopCombinators +Lib.Vec.Lemmas'" + + +let rec lemma_repeat_gen_vec w n a a_vec normalize_v f f_v acc_v0 = + if n = 0 then begin + Loops.eq_repeat_right 0 n a_vec f_v acc_v0; + Loops.eq_repeat_right 0 (w * n) a f (normalize_v 0 acc_v0) end + else begin + let next_p = Loops.repeat_right 0 (n - 1) a_vec f_v acc_v0 in + let next_v = Loops.repeat_right 0 (w * (n - 1)) a f (normalize_v 0 acc_v0) in + + calc (==) { + Loops.repeat_right 0 (w * n) a f (normalize_v 0 acc_v0); + (==) { Loops.repeat_right_plus 0 (w * (n - 1)) (w * n) a f (normalize_v 0 acc_v0) } + Loops.repeat_right (w * (n - 1)) (w * n) a f next_v; + (==) { lemma_repeat_gen_vec w (n - 1) a a_vec normalize_v f f_v acc_v0 } + Loops.repeat_right (w * (n - 1)) (w * n) a f (normalize_v (n - 1) next_p); + (==) { } + normalize_v n (f_v (n - 1) next_p); + (==) { Loops.unfold_repeat_right 0 n a_vec f_v acc_v0 (n - 1) } + normalize_v n (Loops.repeat_right 0 n a_vec f_v acc_v0); + } end + + +let lemma_repeati_vec #a #a_vec w n normalize_v f f_v acc_v0 = + lemma_repeat_gen_vec w n (Loops.fixed_a a) (Loops.fixed_a a_vec) (Loops.fixed_i normalize_v) f f_v acc_v0; + Loops.repeati_def n f_v acc_v0; + Loops.repeati_def (w * n) f (normalize_v acc_v0) + + +let len_is_w_n_blocksize w blocksize n = + let len = w * n * blocksize in + Math.Lemmas.cancel_mul_mod (w * n) blocksize; + //assert (len % blocksize = 0); + Math.Lemmas.cancel_mul_div (w * n) blocksize; + //assert (len / blocksize = w * n); + + Math.Lemmas.paren_mul_right n w blocksize; + Math.Lemmas.cancel_mul_mod n (w * blocksize); + Math.Lemmas.cancel_mul_div n (w * blocksize) + + +//////////////////////// +// Start of proof of lemma_repeat_gen_blocks_multi_vec +//////////////////////// + +val get_block_v: + #a:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> s:seq a{length s = w * n * blocksize} + -> i:nat{i < n} -> + lseq a (w * blocksize) + +let get_block_v #a w blocksize n s i = + let blocksize_v = w * blocksize in + Math.Lemmas.lemma_mult_le_right blocksize_v (i + 1) n; + Math.Lemmas.paren_mul_right n w blocksize; + let b_v = Seq.slice s (i * blocksize_v) ((i + 1) * blocksize_v) in + b_v + + +val repeat_gen_blocks_slice_k: + #inp_t:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> hi_f:nat{w * n <= hi_f} + -> inp:seq inp_t{length inp = w * n * blocksize} + -> a:(i:nat{i <= hi_f} -> Type) + -> f:(i:nat{i < hi_f} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> i:nat{i < n /\ w * i + w <= w * n} + -> k:nat{w * i <= k /\ k < w * i + w} + -> acc:a k -> + Lemma + (let b_v = get_block_v w blocksize n inp i in + let f_rep_s = repeat_gen_blocks_f blocksize (w * i) hi_f w b_v a f in + Math.Lemmas.paren_mul_right w n blocksize; + let f_rep = repeat_gen_blocks_f blocksize 0 (w * n) (w * n) inp a f in + + f_rep_s k acc == f_rep k acc) + +let repeat_gen_blocks_slice_k #inp_t w blocksize n hi_f inp a f i k acc = + // Math.Lemmas.paren_mul_right w n blocksize; + // let f_rep = repeat_gen_blocks_f blocksize 0 (w * n) (w * n) inp a f in + // Math.Lemmas.lemma_mult_le_right blocksize (k + 1) (w * n); + // assert ((k + 1) * blocksize <= w * n * blocksize); + // let block = Seq.slice inp (k * blocksize) (k * blocksize + blocksize) in + // assert (f_rep k acc == f k block acc); + + let b_v = get_block_v w blocksize n inp i in + //let f_rep_s = repeat_gen_blocks_f blocksize (w * i) hi_f w b_v a f in + let i_b = k - w * i in + Math.Lemmas.lemma_mult_le_right blocksize (i_b + 1) w; + let block1 = Seq.slice b_v (i_b * blocksize) (i_b * blocksize + blocksize) in + //assert (f_rep_s k acc == f k block1 acc); + + let blocksize_v = w * blocksize in + calc (<=) { + (i + 1) * blocksize_v; + (<=) { Math.Lemmas.lemma_mult_le_right blocksize_v (i + 1) n } + n * blocksize_v; + (==) { Math.Lemmas.paren_mul_right n w blocksize } + length inp; + }; + + calc (==) { + i * blocksize_v + (k - w * i) * blocksize; + (==) { Math.Lemmas.paren_mul_right i w blocksize } + i * w * blocksize + (k - w * i) * blocksize; + (==) { Math.Lemmas.distributivity_add_left (i * w) (k - w * i) blocksize } + (i * w + (k - w * i)) * blocksize; + (==) { } + (i * w + (k + (- w * i))) * blocksize; + (==) { Math.Lemmas.paren_add_right (i * w) k (- w * i) } + (i * w + k + (- w * i)) * blocksize; + (==) { Math.Lemmas.swap_mul i w } // JP: this was the important one that made the proof brittle + k * blocksize; + }; + + Seq.Properties.slice_slice inp (i * blocksize_v) ((i + 1) * blocksize_v) (i_b * blocksize) (i_b * blocksize + blocksize) + +val repeat_gen_blocks_slice: + #inp_t:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> hi_f:nat{w * n <= hi_f} + -> inp:seq inp_t{length inp = w * n * blocksize} + -> a:(i:nat{i <= hi_f} -> Type) + -> f:(i:nat{i < hi_f} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> i:nat{i < n /\ w * i + w <= w * n} + -> acc:a (w * i) -> + Lemma + (let b_v = get_block_v w blocksize n inp i in + let f_rep_s = repeat_gen_blocks_f blocksize (w * i) hi_f w b_v a f in + Math.Lemmas.paren_mul_right w n blocksize; + let f_rep = repeat_gen_blocks_f blocksize 0 (w * n) (w * n) inp a f in + + Loops.repeat_right (w * i) (w * i + w) a f_rep acc == + Loops.repeat_right (w * i) (w * i + w) a f_rep_s acc) + +let repeat_gen_blocks_slice #inp_t w blocksize n hi_f inp a f i acc = + let b_v = get_block_v w blocksize n inp i in + let f_rep_s = repeat_gen_blocks_f blocksize (w * i) hi_f w b_v a f in + Math.Lemmas.paren_mul_right w n blocksize; + let f_rep = repeat_gen_blocks_f blocksize 0 (w * n) (w * n) inp a f in + + Classical.forall_intro_2 (repeat_gen_blocks_slice_k #inp_t w blocksize n hi_f inp a f i); + repeat_right_extensionality w (w * i) a a f_rep f_rep_s acc + + +val repeat_gen_blocks_multi_vec_step: + #inp_t:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> hi_f:nat{w * n <= hi_f} + -> inp:seq inp_t{length inp = w * n * blocksize} + -> a:(i:nat{i <= hi_f} -> Type) + -> a_vec:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < hi_f} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> f_v:(i:nat{i < n} -> lseq inp_t (w * blocksize) -> a_vec i -> a_vec (i + 1)) + -> normalize_v:(i:nat{i <= n} -> a_vec i -> a (w * i)) + -> pre:squash(forall (i:nat{i < n}) (b_v:lseq inp_t (w * blocksize)) (acc_v:a_vec i). + repeat_gen_blocks_multi_vec_equiv_pre w blocksize n hi_f a a_vec f f_v normalize_v i b_v acc_v) + -> i:nat{i < n} + -> acc_v:a_vec i -> + Lemma + (let blocksize_v = w * blocksize in + len_is_w_n_blocksize w blocksize n; + + let f_rep_v = repeat_gen_blocks_f blocksize_v 0 n n inp a_vec f_v in + let f_rep = repeat_gen_blocks_f blocksize 0 (w * n) (w * n) inp a f in + Math.Lemmas.lemma_mult_le_right w (i + 1) n; + + normalize_v (i + 1) (f_rep_v i acc_v) == + Loops.repeat_right (w * i) (w * (i + 1)) a f_rep (normalize_v i acc_v)) + +let repeat_gen_blocks_multi_vec_step #inp_t w blocksize n hi_f inp a a_vec f f_v normalize_v pre i acc_v = + let b_v = get_block_v w blocksize n inp i in + + //let f_rep_v = repeat_gen_blocks_f blocksize_v 0 n n inp a_vec f_v in + let f_rep = repeat_gen_blocks_f blocksize 0 (w * n) (w * n) inp a f in + Math.Lemmas.lemma_mult_le_left w (i + 1) n; + let f_rep_s = repeat_gen_blocks_f blocksize (w * i) hi_f w b_v a f in + + let acc0 = normalize_v i acc_v in + calc (==) { + repeat_gen_blocks_multi blocksize (w * i) hi_f w b_v a f acc0; + (==) { lemma_repeat_gen_blocks_multi blocksize (w * i) hi_f w b_v a f acc0 } + Loops.repeat_right (w * i) (w * i + w) a f_rep_s acc0; + (==) { repeat_gen_blocks_slice #inp_t w blocksize n hi_f inp a f i acc0 } + Loops.repeat_right (w * i) (w * i + w) a f_rep acc0; + }; + + assert (repeat_gen_blocks_multi_vec_equiv_pre w blocksize n hi_f a a_vec f f_v normalize_v i b_v acc_v) + +#push-options "--z3rlimit_factor 12" +let lemma_repeat_gen_blocks_multi_vec #inp_t w blocksize n hi_f inp a a_vec f f_v normalize_v acc_v0 = + let len = length inp in + let blocksize_v = w * blocksize in + len_is_w_n_blocksize w blocksize n; + + let f_rep_v = repeat_gen_blocks_f blocksize_v 0 n n inp a_vec f_v in + let f_rep = repeat_gen_blocks_f blocksize 0 (w * n) (w * n) inp a f in + + let acc0 = normalize_v 0 acc_v0 in + + calc (==) { + normalize_v n (repeat_gen_blocks_multi blocksize_v 0 n n inp a_vec f_v acc_v0); + (==) { lemma_repeat_gen_blocks_multi blocksize_v 0 n n inp a_vec f_v acc_v0 } + normalize_v n (Loops.repeat_right 0 n a_vec f_rep_v acc_v0); + (==) { + Classical.forall_intro_2 (repeat_gen_blocks_multi_vec_step w blocksize n hi_f inp a a_vec f f_v normalize_v ()); + lemma_repeat_gen_vec w n a a_vec normalize_v f_rep f_rep_v acc_v0 } + Loops.repeat_right 0 (w * n) a f_rep acc0; + (==) { lemma_repeat_gen_blocks_multi blocksize 0 (w * n) (w * n) inp a f acc0 } + repeat_gen_blocks_multi blocksize 0 (w * n) (w * n) inp a f acc0; + (==) { repeat_gen_blocks_multi_extensionality_zero blocksize 0 (w * n) hi_f (w * n) inp a a f f acc0 } + repeat_gen_blocks_multi blocksize 0 hi_f (w * n) inp a f acc0; + } +#pop-options + +//////////////////////// +// End of proof of lemma_repeat_gen_blocks_multi_vec +//////////////////////// + +#push-options "--z3rlimit 100 --retry 2" +let lemma_repeat_gen_blocks_vec #inp_t #c w blocksize inp n a a_vec f l f_v l_v normalize_v acc_v0 = + let len = length inp in + let blocksize_v = w * blocksize in + let rem_v = len % blocksize_v in + + let res_v = repeat_gen_blocks blocksize_v 0 n inp a_vec f_v l_v acc_v0 in + lemma_repeat_gen_blocks blocksize_v 0 n inp a_vec f_v l_v acc_v0; + + let len0 = w * n * blocksize in + let blocks_v = Seq.slice inp 0 len0 in + let last_v = Seq.slice inp len0 len in + let acc_v = repeat_gen_blocks_multi blocksize_v 0 n n blocks_v a_vec f_v acc_v0 in + assert (res_v == l_v n rem_v last_v acc_v); + + let acc0 = normalize_v 0 acc_v0 in + calc (==) { + l_v n rem_v last_v acc_v; + (==) { assert (repeat_gen_blocks_vec_equiv_pre w blocksize n a a_vec f l l_v normalize_v rem_v last_v acc_v) } + repeat_gen_blocks blocksize (w * n) (w * n + w) last_v a f l (normalize_v n acc_v); + (==) { lemma_repeat_gen_blocks_multi_vec w blocksize n (w * n + w) blocks_v a a_vec f f_v normalize_v acc_v0 } + repeat_gen_blocks blocksize (w * n) (w * n + w) last_v a f l + (repeat_gen_blocks_multi blocksize 0 (w * n + w) (w * n) blocks_v a f acc0); + }; + + len_is_w_n_blocksize w blocksize n; + //assert (len0 % blocksize = 0 /\ len0 / blocksize = w * n); + //Math.Lemmas.paren_mul_right n w blocksize; + //div_mul_lt blocksize rem_v w; + //assert (rem_v / blocksize < w); + repeat_gen_blocks_split blocksize len0 (w * n + w) 0 inp a f l acc0 +#pop-options + + +val lemma_repeat_blocks_multi_vec_equiv_pre: + #a:Type0 + -> #b:Type0 + -> #b_vec:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> hi_f:nat{w * n <= hi_f} + -> f:(lseq a blocksize -> b -> b) + -> f_v:(lseq a (w * blocksize) -> b_vec -> b_vec) + -> normalize_v:(b_vec -> b) + -> pre:squash (forall (b_v:lseq a (w * blocksize)) (acc_v:b_vec). + repeat_blocks_multi_vec_equiv_pre w blocksize f f_v normalize_v b_v acc_v) + -> i:nat{i < n} + -> b_v:lseq a (w * blocksize) + -> acc_v:b_vec -> + Lemma + (repeat_gen_blocks_multi_vec_equiv_pre #a w blocksize n hi_f + (Loops.fixed_a b) (Loops.fixed_a b_vec) + (Loops.fixed_i f) (Loops.fixed_i f_v) + (Loops.fixed_i normalize_v) i b_v acc_v) + +let lemma_repeat_blocks_multi_vec_equiv_pre #a #b #b_vec w blocksize n hi_f f f_v normalize_v pre i b_v acc_v = + assert (repeat_blocks_multi_vec_equiv_pre w blocksize f f_v normalize_v b_v acc_v); + Math.Lemmas.cancel_mul_mod w blocksize; + assert (normalize_v (f_v b_v acc_v) == repeat_blocks_multi blocksize b_v f (normalize_v acc_v)); + Math.Lemmas.cancel_mul_div w blocksize; + + Math.Lemmas.lemma_mult_le_right w (i + 1) n; + + calc (==) { + repeat_blocks_multi blocksize b_v f (normalize_v acc_v); + (==) { repeat_blocks_multi_is_repeat_gen_blocks_multi w blocksize b_v f (normalize_v acc_v) } + repeat_gen_blocks_multi blocksize 0 w w b_v (Loops.fixed_a b) (Loops.fixed_i f) (normalize_v acc_v); + (==) { repeat_gen_blocks_multi_extensionality_zero blocksize (w * i) hi_f w w b_v + (Loops.fixed_a b) (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i f) (normalize_v acc_v) } + repeat_gen_blocks_multi blocksize (w * i) hi_f w b_v (Loops.fixed_a b) (Loops.fixed_i f) (normalize_v acc_v); + } + + +let lemma_repeat_blocks_multi_vec #a #b #b_vec w blocksize inp f f_v normalize_v acc_v0 = + let blocksize_v = w * blocksize in + let len = length inp in + let nw = len / blocksize_v in + len_is_w_n_blocksize w blocksize nw; + + let acc0 = normalize_v acc_v0 in + + calc (==) { + normalize_v (repeat_blocks_multi #a #b_vec blocksize_v inp f_v acc_v0); + (==) { repeat_blocks_multi_is_repeat_gen_blocks_multi nw blocksize_v inp f_v acc_v0 } + normalize_v (repeat_gen_blocks_multi blocksize_v 0 nw nw inp (Loops.fixed_a b_vec) (Loops.fixed_i f_v) acc_v0); + (==) { + Classical.forall_intro_3 (lemma_repeat_blocks_multi_vec_equiv_pre w blocksize nw (w * nw) f f_v normalize_v ()); + lemma_repeat_gen_blocks_multi_vec w blocksize nw (w * nw) inp (Loops.fixed_a b) (Loops.fixed_a b_vec) + (Loops.fixed_i f) (Loops.fixed_i f_v) (Loops.fixed_i normalize_v) acc_v0 } + repeat_gen_blocks_multi blocksize 0 (nw * w) (nw * w) inp (Loops.fixed_a b) (Loops.fixed_i f) acc0; + (==) { repeat_blocks_multi_is_repeat_gen_blocks_multi (nw * w) blocksize inp f acc0 } + repeat_blocks_multi blocksize inp f acc0; + } + + +val lemma_repeat_blocks_vec_equiv_pre: + #a:Type0 + -> #b:Type0 + -> #b_vec:Type0 + -> #c:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> f:(lseq a blocksize -> b -> b) + -> l:(len:nat{len < blocksize} -> lseq a len -> b -> c) + -> l_v:(len:nat{len < w * blocksize} -> lseq a len -> b_vec -> c) + -> normalize_v:(b_vec -> b) + -> pre:squash (forall (rem:nat{rem < w * blocksize}) (b_v:lseq a rem) (acc_v:b_vec). + repeat_blocks_vec_equiv_pre w blocksize f l l_v normalize_v rem b_v acc_v) + -> rem:nat{rem < w * blocksize} + -> b_v:lseq a rem + -> acc_v:b_vec -> + Lemma + (repeat_gen_blocks_vec_equiv_pre #a #c w blocksize n + (Loops.fixed_a b) (Loops.fixed_a b_vec) + (Loops.fixed_i f) (Loops.fixed_i l) (Loops.fixed_i l_v) + (Loops.fixed_i normalize_v) rem b_v acc_v) + +let lemma_repeat_blocks_vec_equiv_pre #a #b #b_vec #c w blocksize n f l l_v normalize_v pre rem b_v acc_v = + let nb_rem = rem / blocksize in + div_mul_lt blocksize rem w; + assert (nb_rem < w); + + let acc0 = normalize_v acc_v in + + calc (==) { + Loops.fixed_i l_v n rem b_v acc_v; + (==) { } + l_v rem b_v acc_v; + (==) { assert (repeat_blocks_vec_equiv_pre w blocksize f l l_v normalize_v rem b_v acc_v) } + repeat_blocks blocksize b_v f l acc0; + (==) { repeat_blocks_is_repeat_gen_blocks nb_rem blocksize b_v f l acc0 } + repeat_gen_blocks blocksize 0 nb_rem b_v (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i l) acc0; + (==) { repeat_gen_blocks_extensionality_zero blocksize (w * n) (w * n + w) nb_rem nb_rem b_v + (Loops.fixed_a b) (Loops.fixed_a b) + (Loops.fixed_i f) (Loops.fixed_i l) + (Loops.fixed_i f) (Loops.fixed_i l) acc0 } + repeat_gen_blocks blocksize (w * n) (w * n + w) b_v (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i l) acc0; + } + + +let lemma_repeat_blocks_vec #a #b #b_vec #c w blocksize inp f l f_v l_v normalize_v acc_v0 = + let blocksize_v = w * blocksize in + let nb_v = length inp / blocksize_v in + + calc (==) { + repeat_blocks blocksize_v inp f_v l_v acc_v0; + (==) { repeat_blocks_is_repeat_gen_blocks nb_v blocksize_v inp f_v l_v acc_v0 } + repeat_gen_blocks blocksize_v 0 nb_v inp (Loops.fixed_a b_vec) (Loops.fixed_i f_v) (Loops.fixed_i l_v) acc_v0; + (==) { Classical.forall_intro_3 (lemma_repeat_blocks_multi_vec_equiv_pre w blocksize nb_v (w * nb_v + w) f f_v normalize_v ()); + Classical.forall_intro_3 (lemma_repeat_blocks_vec_equiv_pre #a #b #b_vec #c w blocksize nb_v f l l_v normalize_v ()); + lemma_repeat_gen_blocks_vec w blocksize inp nb_v + (Loops.fixed_a b) (Loops.fixed_a b_vec) (Loops.fixed_i f) (Loops.fixed_i l) + (Loops.fixed_i f_v) (Loops.fixed_i l_v) (Loops.fixed_i normalize_v) acc_v0 } + repeat_gen_blocks blocksize 0 (w * nb_v + w) inp (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i l) (normalize_v acc_v0); + (==) { repeat_blocks_is_repeat_gen_blocks (w * nb_v + w) blocksize inp f l (normalize_v acc_v0) } + repeat_blocks blocksize inp f l (normalize_v acc_v0); + } + + +//////////////////////// +// Start of proof of map_blocks_multi_vec lemma +//////////////////////// + +let lemma_f_map_ind w blocksize n i k = + calc (<) { + w * i + k / blocksize; + (<) { div_mul_lt blocksize k w } + w * i + w; + (==) { Math.Lemmas.distributivity_add_right w i 1 } + w * (i + 1); + (<=) { Math.Lemmas.lemma_mult_le_left w (i + 1) n } + w * n; + } + + +val normalize_v_map: + #a:Type + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> i:nat{i <= n} + -> map_blocks_a a (w * blocksize) n i -> + map_blocks_a a blocksize (w * n) (w * i) + +let normalize_v_map #a w blocksize n i b = + Math.Lemmas.lemma_mult_le_right w i n; + b + + +#push-options "--z3rlimit 75" +let map_blocks_multi_vec_equiv_pre + (#a:Type) + (w:pos) + (blocksize:pos{w * blocksize <= max_size_t}) + (n:nat) + (hi_f:nat{w * n <= hi_f}) + (f:(i:nat{i < hi_f} -> lseq a blocksize -> lseq a blocksize)) + (f_v:(i:nat{i < n} -> lseq a (w * blocksize) -> lseq a (w * blocksize))) + (i:nat{i < n}) + (b_v:lseq a (w * blocksize)) + (acc_v:map_blocks_a a (w * blocksize) n i) + : prop + = + Math.Lemmas.lemma_mult_le_right w (i + 1) n; + repeat_gen_blocks_map_f #a (w * blocksize) n f_v i b_v acc_v `Seq.equal` + map_blocks_multi_acc blocksize (w * i) hi_f w b_v f acc_v +#pop-options + +// It means the following +// Seq.append acc_v (f_v i b_v) == +// map_blocks_multi_acc blocksize (w * i) (w * n) w b_v f acc_v + + +val lemma_map_blocks_multi_vec_equiv_pre_k: + #a:Type + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> hi_f:nat{w * n <= hi_f} + -> f:(i:nat{i < hi_f} -> lseq a blocksize -> lseq a blocksize) + -> f_v:(i:nat{i < n} -> lseq a (w * blocksize) -> lseq a (w * blocksize)) + -> i:nat{i < n} + -> b_v:lseq a (w * blocksize) + -> pre:squash (forall (k:nat{k < w * blocksize}). map_blocks_multi_vec_equiv_pre_k w blocksize n (w * n) f f_v i b_v k) + -> acc_v:map_blocks_a a (w * blocksize) n i -> + Lemma (map_blocks_multi_vec_equiv_pre #a w blocksize n hi_f f f_v i b_v acc_v) + +#push-options "--z3rlimit 150" +let lemma_map_blocks_multi_vec_equiv_pre_k #a w blocksize n hi_f f f_v i b_v pre acc_v = + //let lp = repeat_gen_blocks_map_f #a (w * blocksize) n f_v i b_v acc_v in + //assert (lp == Seq.append acc_v (f_v i b_v)); + + Math.Lemmas.lemma_mult_le_right w (i + 1) n; + let f_sh = f_shift blocksize (w * i) hi_f w f in + + let aux (k:nat{k < w * blocksize}) : Lemma (Seq.index (f_v i b_v) k == Seq.index (map_blocks_multi blocksize w w b_v f_sh) k) = + Math.Lemmas.cancel_mul_div w blocksize; + let block = get_block_s #a #(w * blocksize) blocksize b_v k in + let j = k / blocksize in // j < w + div_mul_lt blocksize k w; + + calc (==) { + Seq.index (map_blocks_multi blocksize w w b_v f_sh) k; + (==) { index_map_blocks_multi blocksize w w b_v f_sh k } + Seq.index (f_sh j block) (k % blocksize); + (==) { assert (map_blocks_multi_vec_equiv_pre_k w blocksize n hi_f f f_v i b_v k) } + Seq.index (f_v i b_v) k; + } in + + calc (==) { + map_blocks_multi_acc blocksize (w * i) hi_f w b_v f acc_v; + (==) { map_blocks_multi_acc_is_map_blocks_multi blocksize (w * i) hi_f w b_v f acc_v } + Seq.append acc_v (map_blocks_multi blocksize w w b_v f_sh); + (==) { Classical.forall_intro aux; Seq.lemma_eq_intro (f_v i b_v) (map_blocks_multi blocksize w w b_v f_sh) } + Seq.append acc_v (f_v i b_v); + (==) { Seq.lemma_eq_intro (Seq.append acc_v (f_v i b_v)) (repeat_gen_blocks_map_f #a (w * blocksize) n f_v i b_v acc_v) } + repeat_gen_blocks_map_f #a (w * blocksize) n f_v i b_v acc_v; + } +#pop-options + +val lemma_map_blocks_multi_vec_equiv_pre: + #a:Type + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> hi_f:nat{w * n <= hi_f} + -> f:(i:nat{i < hi_f} -> lseq a blocksize -> lseq a blocksize) + -> f_v:(i:nat{i < n} -> lseq a (w * blocksize) -> lseq a (w * blocksize)) + -> pre:squash (forall (i:nat{i < n}) (b_v:lseq a (w * blocksize)) (k:nat{k < w * blocksize}). + map_blocks_multi_vec_equiv_pre_k w blocksize n (w * n) f f_v i b_v k) + -> i:nat{i < n} + -> b_v:lseq a (w * blocksize) + -> acc_v:map_blocks_a a (w * blocksize) n i -> + Lemma + (repeat_gen_blocks_multi_vec_equiv_pre #a w blocksize n hi_f + (map_blocks_a a blocksize hi_f) + (map_blocks_a a (w * blocksize) n) + (repeat_gen_blocks_map_f blocksize hi_f f) + (repeat_gen_blocks_map_f (w * blocksize) n f_v) + (normalize_v_map #a w blocksize n) i b_v acc_v) + +#push-options "--z3rlimit 75" +let lemma_map_blocks_multi_vec_equiv_pre #a w blocksize n hi_f f f_v pre i b_v acc_v = + lemma_map_blocks_multi_vec_equiv_pre_k #a w blocksize n hi_f f f_v i b_v pre acc_v; + Math.Lemmas.cancel_mul_div w blocksize; + Math.Lemmas.cancel_mul_mod w blocksize; + Math.Lemmas.lemma_mult_le_right w (i + 1) n; + map_blocks_multi_acc_is_repeat_gen_blocks_multi blocksize (w * i) hi_f w b_v f acc_v +#pop-options + +let lemma_map_blocks_multi_vec #a w blocksize n inp f f_v = + let blocksize_v = w * blocksize in + len_is_w_n_blocksize w blocksize n; + + calc (==) { + map_blocks_multi blocksize_v n n inp f_v; + (==) { map_blocks_multi_acc_is_map_blocks_multi0 blocksize_v n n inp f_v } + map_blocks_multi_acc blocksize_v 0 n n inp f_v Seq.empty; + (==) { map_blocks_multi_acc_is_repeat_gen_blocks_multi blocksize_v 0 n n inp f_v Seq.empty } + repeat_gen_blocks_multi blocksize_v 0 n n inp + (map_blocks_a a blocksize_v n) + (repeat_gen_blocks_map_f blocksize_v n f_v) Seq.empty; + (==) { Classical.forall_intro_3 (lemma_map_blocks_multi_vec_equiv_pre #a w blocksize n (w * n) f f_v ()); + lemma_repeat_gen_blocks_multi_vec w blocksize n (w * n) inp + (map_blocks_a a blocksize (w * n)) (map_blocks_a a blocksize_v n) + (repeat_gen_blocks_map_f blocksize (w * n) f) + (repeat_gen_blocks_map_f blocksize_v n f_v) + (normalize_v_map #a w blocksize n) Seq.empty } + repeat_gen_blocks_multi blocksize 0 (w * n) (w * n) inp + (map_blocks_a a blocksize (w * n)) + (repeat_gen_blocks_map_f blocksize (w * n) f) Seq.empty; + (==) { map_blocks_multi_acc_is_repeat_gen_blocks_multi blocksize 0 (w * n) (w * n) inp f Seq.empty } + map_blocks_multi_acc blocksize 0 (w * n) (w * n) inp f Seq.empty; + (==) { map_blocks_multi_acc_is_map_blocks_multi0 blocksize (w * n) (w * n) inp f } + map_blocks_multi blocksize (w * n) (w * n) inp f; + } + +//////////////////////// +// End of proof of map_blocks_multi_vec lemma +//////////////////////// + +#push-options "--z3rlimit 75" +let map_blocks_vec_equiv_pre + (#a:Type) + (w:pos) + (blocksize:pos{w * blocksize <= max_size_t}) + (n:nat) + (f:(i:nat{i < w * n + w} -> lseq a blocksize -> lseq a blocksize)) + (l:(i:nat{i <= w * n + w} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem)) + (l_v:(i:nat{i <= n} -> rem:nat{rem < w * blocksize} -> lseq a rem -> lseq a rem)) + (rem:nat{rem < w * blocksize}) + (b_v:lseq a rem) + (acc_v:map_blocks_a a (w * blocksize) n n) + : prop + = + //Math.Lemmas.small_mod rem (w * blocksize); + //Math.Lemmas.small_div rem (w * blocksize); + repeat_gen_blocks_map_l_length (w * blocksize) n l_v n rem b_v acc_v; + + repeat_gen_blocks_map_l (w * blocksize) n l_v n rem b_v acc_v `Seq.equal` + map_blocks_acc blocksize (w * n) (w * n + w) b_v f l acc_v +#pop-options + +val lemma_map_blocks_vec_equiv_pre_k_aux: + #a:Type + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> f:(i:nat{i < w * n + w} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= w * n + w} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> l_v:(i:nat{i <= n} -> rem:nat{rem < w * blocksize} -> lseq a rem -> lseq a rem) + -> rem:nat{rem < w * blocksize} + -> b_v:lseq a rem + -> pre:squash (forall (rem:nat{rem < w * blocksize}) (b_v:lseq a rem) (k:nat{k < rem}). + map_blocks_vec_equiv_pre_k w blocksize n f l l_v rem b_v k) + -> k:nat{k < rem} -> + Lemma + (let nb = rem / blocksize in + let f_sh = f_shift blocksize (w * n) (w * n + w) nb f in + let l_sh = l_shift blocksize (w * n) (w * n + w) nb l in + Seq.index (l_v n rem b_v) k == Seq.index (map_blocks blocksize b_v f_sh l_sh) k) + +let lemma_map_blocks_vec_equiv_pre_k_aux #a w blocksize n f l l_v rem b_v pre k = + let nb = rem / blocksize in + let f_sh = f_shift blocksize (w * n) (w * n + w) nb f in + let l_sh = l_shift blocksize (w * n) (w * n + w) nb l in + + let j = w * n + k / blocksize in + div_mul_lt blocksize k w; + + if k < rem / blocksize * blocksize then begin + let block = get_block_s #a #rem blocksize b_v k in + calc (==) { + Seq.index (map_blocks blocksize b_v f_sh l_sh) k; + (==) { index_map_blocks blocksize b_v f_sh l_sh k } + Seq.index (f j block) (k % blocksize); + (==) { assert (map_blocks_vec_equiv_pre_k w blocksize n f l l_v rem b_v k) } + Seq.index (l_v n rem b_v) k; + } end + else begin + let block_l = get_last_s #_ #rem blocksize b_v in + mod_div_lt blocksize k rem; + calc (==) { + Seq.index (map_blocks blocksize b_v f_sh l_sh) k; + (==) { index_map_blocks blocksize b_v f_sh l_sh k } + Seq.index (l_sh (rem / blocksize) (rem % blocksize) block_l) (k % blocksize); + (==) { div_interval blocksize (rem / blocksize) k } + Seq.index (l j (rem % blocksize) block_l) (k % blocksize); + (==) { assert (map_blocks_vec_equiv_pre_k w blocksize n f l l_v rem b_v k) } + Seq.index (l_v n rem b_v) k; + } end + + +val lemma_map_blocks_vec_equiv_pre_k: + #a:Type + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> f:(i:nat{i < w * n + w} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= w * n + w} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> l_v:(i:nat{i <= n} -> rem:nat{rem < w * blocksize} -> lseq a rem -> lseq a rem) + -> rem:nat{rem < w * blocksize} + -> b_v:lseq a rem + -> pre:squash (forall (rem:nat{rem < w * blocksize}) (b_v:lseq a rem) (k:nat{k < rem}). + map_blocks_vec_equiv_pre_k w blocksize n f l l_v rem b_v k) + -> acc_v:map_blocks_a a (w * blocksize) n n -> + Lemma (map_blocks_vec_equiv_pre w blocksize n f l l_v rem b_v acc_v) + +let lemma_map_blocks_vec_equiv_pre_k #a w blocksize n f l l_v rem b_v pre acc_v = + let nb = rem / blocksize in + let f_sh = f_shift blocksize (w * n) (w * n + w) nb f in + let l_sh = l_shift blocksize (w * n) (w * n + w) nb l in + + if rem = 0 then begin + calc (==) { + map_blocks_acc blocksize (w * n) (w * n + w) b_v f l acc_v; + (==) { map_blocks_acc_is_map_blocks blocksize (w * n) (w * n + w) b_v f l acc_v} + Seq.append acc_v (map_blocks blocksize b_v f_sh l_sh); + (==) { map_blocks_is_empty blocksize nb b_v f_sh l_sh } + Seq.append acc_v Seq.empty; + (==) { Seq.Base.append_empty_r acc_v } + acc_v; + (==) { } + repeat_gen_blocks_map_l (w * blocksize) n l_v n rem b_v acc_v; + } end + else begin + calc (==) { + map_blocks_acc blocksize (w * n) (w * n + w) b_v f l acc_v; + (==) { map_blocks_acc_is_map_blocks blocksize (w * n) (w * n + w) b_v f l acc_v} + Seq.append acc_v (map_blocks blocksize b_v f_sh l_sh); + (==) { Classical.forall_intro (lemma_map_blocks_vec_equiv_pre_k_aux #a w blocksize n f l l_v rem b_v ()); + Seq.lemma_eq_intro (l_v n rem b_v) (map_blocks blocksize b_v f_sh l_sh) } + Seq.append acc_v (l_v n rem b_v); + (==) { } + repeat_gen_blocks_map_l (w * blocksize) n l_v n rem b_v acc_v; + } end + + +val lemma_map_blocks_vec_equiv_pre: + #a:Type + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> f:(i:nat{i < w * n + w} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= w * n + w} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> l_v:(i:nat{i <= n} -> rem:nat{rem < w * blocksize} -> lseq a rem -> lseq a rem) + -> pre:squash (forall (rem:nat{rem < w * blocksize}) (b_v:lseq a rem) (k:nat{k < rem}). + map_blocks_vec_equiv_pre_k w blocksize n f l l_v rem b_v k) + -> rem:nat{rem < w * blocksize} + -> b_v:lseq a rem + -> acc_v:map_blocks_a a (w * blocksize) n n -> + Lemma + (repeat_gen_blocks_vec_equiv_pre w blocksize n + (map_blocks_a a blocksize (w * n + w)) + (map_blocks_a a (w * blocksize) n) + (repeat_gen_blocks_map_f blocksize (w * n + w) f) + (repeat_gen_blocks_map_l blocksize (w * n + w) l) + (repeat_gen_blocks_map_l (w * blocksize) n l_v) + (normalize_v_map #a w blocksize n) rem b_v acc_v) + +let lemma_map_blocks_vec_equiv_pre #a w blocksize n f l l_v pre rem b_v acc_v = + lemma_map_blocks_vec_equiv_pre_k #a w blocksize n f l l_v rem b_v pre acc_v; + Math.Lemmas.small_mod rem (w * blocksize); + Math.Lemmas.small_div rem (w * blocksize); + assert (w * n >= 0); + map_blocks_acc_is_repeat_gen_blocks blocksize (w * n) (w * n + w) b_v f l acc_v + + +let lemma_map_blocks_vec #a w blocksize inp n f l f_v l_v = + let len = length inp in + let blocksize_v = w * blocksize in + + calc (==) { + map_blocks_acc blocksize_v 0 n inp f_v l_v Seq.empty; + (==) { map_blocks_acc_is_repeat_gen_blocks blocksize_v 0 n inp f_v l_v Seq.empty } + repeat_gen_blocks blocksize_v 0 n inp + (map_blocks_a a blocksize_v n) + (repeat_gen_blocks_map_f blocksize_v n f_v) + (repeat_gen_blocks_map_l blocksize_v n l_v) + Seq.empty; + + (==) { + Classical.forall_intro_3 (lemma_map_blocks_multi_vec_equiv_pre #a w blocksize n (w * n + w) f f_v ()); + Classical.forall_intro_3 (lemma_map_blocks_vec_equiv_pre #a w blocksize n f l l_v ()); + lemma_repeat_gen_blocks_vec w blocksize inp n + (map_blocks_a a blocksize (w * n + w)) + (map_blocks_a a (w * blocksize) n) + (repeat_gen_blocks_map_f blocksize (w * n + w) f) + (repeat_gen_blocks_map_l blocksize (w * n + w) l) + (repeat_gen_blocks_map_f (w * blocksize) n f_v) + (repeat_gen_blocks_map_l (w * blocksize) n l_v) + (normalize_v_map #a w blocksize n) Seq.empty } + + repeat_gen_blocks blocksize 0 (w * n + w) inp + (map_blocks_a a blocksize (w * n + w)) + (repeat_gen_blocks_map_f blocksize (w * n + w) f) + (repeat_gen_blocks_map_l blocksize (w * n + w) l) + Seq.empty; + + (==) { map_blocks_acc_is_repeat_gen_blocks blocksize 0 (w * n + w) inp f l Seq.empty } + map_blocks_acc blocksize 0 (w * n + w) inp f l Seq.empty; + }; + + map_blocks_acc_is_map_blocks0 blocksize_v n inp f_v l_v; + map_blocks_acc_is_map_blocks0 blocksize (w * n + w) inp f l diff --git a/tests/hacl/Lib.Vec.Lemmas.fsti b/tests/hacl/Lib.Vec.Lemmas.fsti new file mode 100644 index 00000000000..ec423584a20 --- /dev/null +++ b/tests/hacl/Lib.Vec.Lemmas.fsti @@ -0,0 +1,331 @@ +module Lib.Vec.Lemmas + +open FStar.Mul +open Lib.IntTypes +open Lib.Sequence +open Lib.Sequence.Lemmas + +module Loops = Lib.LoopCombinators + +#push-options "--z3rlimit 30 --max_fuel 0 --max_ifuel 0 \ + --using_facts_from '-* +Prims +FStar.Pervasives +FStar.Math.Lemmas +FStar.Seq -FStar.Seq.Properties.slice_slice \ + +Lib.IntTypes +Lib.Sequence +Lib.Sequence.Lemmas +Lib.LoopCombinators +Lib.Vec.Lemmas'" + + +val lemma_repeat_gen_vec: + w:pos + -> n:nat + -> a:(i:nat{i <= w * n} -> Type) + -> a_vec:(i:nat{i <= n} -> Type) + -> normalize_v:(i:nat{i <= n} -> a_vec i -> a (w * i)) + -> f:(i:nat{i < w * n} -> a i -> a (i + 1)) + -> f_v:(i:nat{i < n} -> a_vec i -> a_vec (i + 1)) + -> acc_v0:a_vec 0 -> + Lemma + (requires (forall (i:nat{i < n}) (acc_v:a_vec i). + (assert (w * (i + 1) <= w * n); + normalize_v (i + 1) (f_v i acc_v) == + Loops.repeat_right (w * i) (w * (i + 1)) a f (normalize_v i acc_v)))) + (ensures + normalize_v n (Loops.repeat_right 0 n a_vec f_v acc_v0) == + Loops.repeat_right 0 (w * n) a f (normalize_v 0 acc_v0)) + + +val lemma_repeati_vec: + #a:Type0 + -> #a_vec:Type0 + -> w:pos + -> n:nat + -> normalize_v:(a_vec -> a) + -> f:(i:nat{i < w * n} -> a -> a) + -> f_v:(i:nat{i < n} -> a_vec -> a_vec) + -> acc_v0:a_vec -> + Lemma + (requires (forall (i:nat{i < n}) (acc_v:a_vec). + (assert (w * (i + 1) <= w * n); + normalize_v (f_v i acc_v) == + Loops.repeat_right (w * i) (w * (i + 1)) (Loops.fixed_a a) f (normalize_v acc_v)))) + (ensures + normalize_v (Loops.repeati n f_v acc_v0) == + Loops.repeati (w * n) f (normalize_v acc_v0)) + +/// +/// Lemma +/// (repeat_gen_blocks (w * blocksize) 0 n inp a_vec f_v l_v acc_v0 == +/// repeat_gen_blocks blocksize 0 (w * n + w) inp a f l (normalize_v 0 acc_v0)) +/// + +val len_is_w_n_blocksize: w:pos -> blocksize:pos -> n:nat -> Lemma + (let len = w * n * blocksize in + len / blocksize = w * n /\ len / (w * blocksize) = n /\ + len % blocksize = 0 /\ len % (w * blocksize) = 0) + + +let repeat_gen_blocks_multi_vec_equiv_pre + (#inp_t:Type0) + (w:pos) + (blocksize:pos{w * blocksize <= max_size_t}) + (n:nat) + (hi_f:nat{w * n <= hi_f}) + (a:(i:nat{i <= hi_f} -> Type)) + (a_vec:(i:nat{i <= n} -> Type)) + (f:(i:nat{i < hi_f} -> lseq inp_t blocksize -> a i -> a (i + 1))) + (f_v:(i:nat{i < n} -> lseq inp_t (w * blocksize) -> a_vec i -> a_vec (i + 1))) + (normalize_v:(i:nat{i <= n} -> a_vec i -> a (w * i))) + (i:nat{i < n}) + (b_v:lseq inp_t (w * blocksize)) + (acc_v:a_vec i) + : prop += + Math.Lemmas.lemma_mult_le_right w (i + 1) n; + + normalize_v (i + 1) (f_v i b_v acc_v) == + repeat_gen_blocks_multi blocksize (w * i) hi_f w b_v a f (normalize_v i acc_v) + + +val lemma_repeat_gen_blocks_multi_vec: + #inp_t:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> hi_f:nat{w * n <= hi_f} + -> inp:seq inp_t{length inp = w * n * blocksize} + -> a:(i:nat{i <= hi_f} -> Type) + -> a_vec:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < hi_f} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> f_v:(i:nat{i < n} -> lseq inp_t (w * blocksize) -> a_vec i -> a_vec (i + 1)) + -> normalize_v:(i:nat{i <= n} -> a_vec i -> a (w * i)) + -> acc_v0:a_vec 0 -> + Lemma + (requires + (forall (i:nat{i < n}) (b_v:lseq inp_t (w * blocksize)) (acc_v:a_vec i). + repeat_gen_blocks_multi_vec_equiv_pre w blocksize n hi_f a a_vec f f_v normalize_v i b_v acc_v)) + (ensures + (len_is_w_n_blocksize w blocksize n; + normalize_v n (repeat_gen_blocks_multi (w * blocksize) 0 n n inp a_vec f_v acc_v0) == + repeat_gen_blocks_multi blocksize 0 hi_f (w * n) inp a f (normalize_v 0 acc_v0))) + + +let repeat_gen_blocks_vec_equiv_pre + (#inp_t:Type0) + (#c:Type0) + (w:pos) + (blocksize:pos{w * blocksize <= max_size_t}) + (n:nat) + (a:(i:nat{i <= w * n + w} -> Type)) + (a_vec:(i:nat{i <= n} -> Type)) + (f:(i:nat{i < w * n + w} -> lseq inp_t blocksize -> a i -> a (i + 1))) + (l:(i:nat{i <= w * n + w} -> len:nat{len < blocksize} -> lseq inp_t len -> a i -> c)) + (l_v:(i:nat{i <= n} -> len:nat{len < w * blocksize} -> lseq inp_t len -> a_vec i -> c)) + (normalize_v:(i:nat{i <= n} -> a_vec i -> a (w * i))) + (rem:nat{rem < w * blocksize}) + (b_v:lseq inp_t rem) + (acc_v:a_vec n) + : prop += + l_v n rem b_v acc_v == + repeat_gen_blocks #inp_t #c blocksize (w * n) (w * n + w) b_v a f l (normalize_v n acc_v) + + +val lemma_repeat_gen_blocks_vec: + #inp_t:Type0 + -> #c:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> inp:seq inp_t + -> n:nat{n = length inp / (w * blocksize)} + -> a:(i:nat{i <= w * n + w} -> Type) + -> a_vec:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < w * n + w} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> l:(i:nat{i <= w * n + w} -> len:nat{len < blocksize} -> lseq inp_t len -> a i -> c) + -> f_v:(i:nat{i < n} -> lseq inp_t (w * blocksize) -> a_vec i -> a_vec (i + 1)) + -> l_v:(i:nat{i <= n} -> len:nat{len < w * blocksize} -> lseq inp_t len -> a_vec i -> c) + -> normalize_v:(i:nat{i <= n} -> a_vec i -> a (w * i)) + -> acc_v0:a_vec 0 -> + Lemma + (requires + (forall (i:nat{i < n}) (b_v:lseq inp_t (w * blocksize)) (acc_v:a_vec i). + repeat_gen_blocks_multi_vec_equiv_pre w blocksize n (w * n + w) a a_vec f f_v normalize_v i b_v acc_v) /\ + (forall (rem:nat{rem < w * blocksize}) (b_v:lseq inp_t rem) (acc_v:a_vec n). + repeat_gen_blocks_vec_equiv_pre w blocksize n a a_vec f l l_v normalize_v rem b_v acc_v)) + (ensures + repeat_gen_blocks (w * blocksize) 0 n inp a_vec f_v l_v acc_v0 == + repeat_gen_blocks blocksize 0 (w * n + w) inp a f l (normalize_v 0 acc_v0)) + +/// +/// Lemma +/// (repeat_blocks (w * blocksize) inp f_v l_v acc_v0 == +/// repeat_blocks blocksize inp f l (normalize_v acc_v0)) +/// + +let repeat_blocks_multi_vec_equiv_pre + (#a:Type0) + (#b:Type0) + (#b_vec:Type0) + (w:pos) + (blocksize:pos{w * blocksize <= max_size_t}) + (f:(lseq a blocksize -> b -> b)) + (f_v:(lseq a (w * blocksize) -> b_vec -> b_vec)) + (normalize_v:(b_vec -> b)) + (b_v:lseq a (w * blocksize)) + (acc_v:b_vec) + : prop += + Math.Lemmas.cancel_mul_mod w blocksize; + normalize_v (f_v b_v acc_v) == repeat_blocks_multi blocksize b_v f (normalize_v acc_v) + + +val lemma_repeat_blocks_multi_vec: + #a:Type0 + -> #b:Type0 + -> #b_vec:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> inp:seq a{length inp % (w * blocksize) = 0 /\ length inp % blocksize = 0} + -> f:(lseq a blocksize -> b -> b) + -> f_v:(lseq a (w * blocksize) -> b_vec -> b_vec) + -> normalize_v:(b_vec -> b) + -> acc_v0:b_vec -> + Lemma + (requires + (forall (b_v:lseq a (w * blocksize)) (acc_v:b_vec). + repeat_blocks_multi_vec_equiv_pre w blocksize f f_v normalize_v b_v acc_v)) + (ensures + normalize_v (repeat_blocks_multi #a #b_vec (w * blocksize) inp f_v acc_v0) == + repeat_blocks_multi #a #b blocksize inp f (normalize_v acc_v0)) + + +let repeat_blocks_vec_equiv_pre + (#a:Type0) + (#b:Type0) + (#b_vec:Type0) + (#c:Type0) + (w:pos) + (blocksize:pos{w * blocksize <= max_size_t}) + (f:(lseq a blocksize -> b -> b)) + (l:(len:nat{len < blocksize} -> lseq a len -> b -> c)) + (l_v:(len:nat{len < w * blocksize} -> lseq a len -> b_vec -> c)) + (normalize_v:(b_vec -> b)) + (rem:nat{rem < w * blocksize}) + (b_v:lseq a rem) + (acc_v:b_vec) + : prop += + l_v rem b_v acc_v == + repeat_blocks blocksize b_v f l (normalize_v acc_v) + + +val lemma_repeat_blocks_vec: + #a:Type0 + -> #b:Type0 + -> #b_vec:Type0 + -> #c:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> inp:seq a + -> f:(lseq a blocksize -> b -> b) + -> l:(len:nat{len < blocksize} -> lseq a len -> b -> c) + -> f_v:(lseq a (w * blocksize) -> b_vec -> b_vec) + -> l_v:(len:nat{len < w * blocksize} -> lseq a len -> b_vec -> c) + -> normalize_v:(b_vec -> b) + -> acc_v0:b_vec -> + Lemma + (requires + (forall (b_v:lseq a (w * blocksize)) (acc_v:b_vec). + repeat_blocks_multi_vec_equiv_pre w blocksize f f_v normalize_v b_v acc_v) /\ + (forall (rem:nat{rem < w * blocksize}) (b_v:lseq a rem) (acc_v:b_vec). + repeat_blocks_vec_equiv_pre w blocksize f l l_v normalize_v rem b_v acc_v)) + (ensures + repeat_blocks (w * blocksize) inp f_v l_v acc_v0 == + repeat_blocks blocksize inp f l (normalize_v acc_v0)) + +/// +/// Lemma +/// (map_blocks (w * blocksize) inp f_v l_v == map_blocks blocksize inp f l) +/// + +val lemma_f_map_ind: w:pos -> blocksize:pos -> n:nat -> i:nat{i < n} -> k:nat{k < w * blocksize} -> + Lemma (w * i + k / blocksize < w * n) + + +let map_blocks_multi_vec_equiv_pre_k + (#a:Type) + (w:pos) + (blocksize:pos{w * blocksize <= max_size_t}) + (n:nat) + (hi_f:nat{w * n <= hi_f}) + (f:(i:nat{i < hi_f} -> lseq a blocksize -> lseq a blocksize)) + (f_v:(i:nat{i < n} -> lseq a (w * blocksize) -> lseq a (w * blocksize))) + (i:nat{i < n}) + (b_v:lseq a (w * blocksize)) + (k:nat{k < w * blocksize}) + : prop + = + Math.Lemmas.cancel_mul_div w blocksize; + let block = get_block_s #a #(w * blocksize) blocksize b_v k in + lemma_f_map_ind w blocksize n i k; + Seq.index (f_v i b_v) k == Seq.index (f (w * i + k / blocksize) block) (k % blocksize) + + +val lemma_map_blocks_multi_vec: + #a:Type + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> inp:seq a{length inp = w * n * blocksize} + -> f:(i:nat{i < w * n} -> lseq a blocksize -> lseq a blocksize) + -> f_v:(i:nat{i < n} -> lseq a (w * blocksize) -> lseq a (w * blocksize)) -> + Lemma + (requires + (forall (i:nat{i < n}) (b_v:lseq a (w * blocksize)) (k:nat{k < w * blocksize}). + map_blocks_multi_vec_equiv_pre_k w blocksize n (w * n) f f_v i b_v k)) + (ensures + (len_is_w_n_blocksize w blocksize n; + map_blocks_multi (w * blocksize) n n inp f_v == + map_blocks_multi blocksize (w * n) (w * n) inp f)) + +#push-options "--z3rlimit_factor 2" +let map_blocks_vec_equiv_pre_k + (#a:Type) + (w:pos) + (blocksize:pos{w * blocksize <= max_size_t}) + (n:nat) + (f:(i:nat{i < w * n + w} -> lseq a blocksize -> lseq a blocksize)) + (l:(i:nat{i <= w * n + w} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem)) + (l_v:(i:nat{i <= n} -> rem:nat{rem < w * blocksize} -> lseq a rem -> lseq a rem)) + (rem:nat{rem < w * blocksize}) + (b_v:lseq a rem) + (k:nat{k < rem}) + : prop + = + let j = w * n + k / blocksize in + div_mul_lt blocksize k w; + + if k < rem / blocksize * blocksize then begin + let block = get_block_s #a #rem blocksize b_v k in + Seq.index (l_v n rem b_v) k == Seq.index (f j block) (k % blocksize) end + else begin + let block_l = get_last_s blocksize b_v in + mod_div_lt blocksize k rem; + assert (k % blocksize < rem % blocksize); + Seq.index (l_v n rem b_v) k == Seq.index (l j (rem % blocksize) block_l) (k % blocksize) end +#pop-options + +val lemma_map_blocks_vec: + #a:Type + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> inp:seq a + -> n:nat{n == length inp / (w * blocksize)} + -> f:(i:nat{i < w * n + w} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= w * n + w} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> f_v:(i:nat{i < n} -> lseq a (w * blocksize) -> lseq a (w * blocksize)) + -> l_v:(i:nat{i <= n} -> rem:nat{rem < w * blocksize} -> lseq a rem -> lseq a rem) -> + Lemma + (requires + (forall (i:nat{i < n}) (b_v:lseq a (w * blocksize)) (k:nat{k < w * blocksize}). + map_blocks_multi_vec_equiv_pre_k w blocksize n (w * n) f f_v i b_v k) /\ + (forall (rem:nat{rem < w * blocksize}) (b_v:lseq a rem) (k:nat{k < rem}). + map_blocks_vec_equiv_pre_k w blocksize n f l l_v rem b_v k)) + (ensures + map_blocks (w * blocksize) inp f_v l_v == map_blocks blocksize inp f l) diff --git a/tests/hacl/Makefile b/tests/hacl/Makefile new file mode 100644 index 00000000000..d17eb4f6033 --- /dev/null +++ b/tests/hacl/Makefile @@ -0,0 +1,14 @@ +FSTAR_HOME=../.. + +FSTAR_FILES = $(wildcard *.fst *.fsti) + +all: verify-all + +include $(FSTAR_HOME)/examples/Makefile.common + +verify-all: $(CACHE_DIR) $(addsuffix .checked, $(addprefix $(CACHE_DIR)/, $(FSTAR_FILES))) + +clean: + rm -f .depend + rm -rf _cache + rm -rf _output From 4a851fc24eef4120445fc4f184f35619a3d55aab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 25 Apr 2024 08:01:16 -0700 Subject: [PATCH 111/239] DMFF: Use UnfoldTac In preparation of a change to come... --- src/typechecker/FStar.TypeChecker.DMFF.fst | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.DMFF.fst b/src/typechecker/FStar.TypeChecker.DMFF.fst index 666f63a077a..7e88e8e2aeb 100644 --- a/src/typechecker/FStar.TypeChecker.DMFF.fst +++ b/src/typechecker/FStar.TypeChecker.DMFF.fst @@ -354,7 +354,7 @@ let gen_wps_for_free in let rec mk_rel rel t x y = let mk_rel = mk_rel rel in - let t = N.normalize [ Env.Beta; Env.Eager_unfolding; Env.UnfoldUntil S.delta_constant ] env t in + let t = N.normalize [ Env.Beta; Env.Eager_unfolding; Env.UnfoldTac; Env.UnfoldUntil S.delta_constant ] env t in match (SS.compress t).n with | Tm_type _ -> (* BU.print2 "type0, x=%s, y=%s\n" (Print.term_to_string x) (Print.term_to_string y); *) @@ -394,7 +394,7 @@ let gen_wps_for_free let wp1 = S.gen_bv "wp1" None wp_a in let wp2 = S.gen_bv "wp2" None wp_a in let rec mk_stronger t x y = - let t = N.normalize [ Env.Beta; Env.Eager_unfolding; Env.UnfoldUntil S.delta_constant ] env t in + let t = N.normalize [ Env.Beta; Env.Eager_unfolding; Env.UnfoldTac; Env.UnfoldUntil S.delta_constant ] env t in match (SS.compress t).n with | Tm_type _ -> U.mk_imp x y | Tm_app {hd=head; args} when is_tuple_constructor (SS.compress head) -> @@ -642,7 +642,7 @@ and star_type' env t = if is_non_dependent_arrow ty (List.length args) then // We need to check that the result of the application is a datatype - let res = N.normalize [Env.EraseUniverses; Env.Inlining ; Env.UnfoldUntil S.delta_constant] env.tcenv t in + let res = N.normalize [Env.EraseUniverses; Env.Inlining ; Env.UnfoldTac; Env.UnfoldUntil S.delta_constant] env.tcenv t in begin match (SS.compress res).n with | Tm_app _ -> true | _ -> @@ -898,7 +898,7 @@ let rec check (env: env) (e: term) (context_nm: nm): nm * term * term = and infer (env: env) (e: term): nm * term * term = // BU.print1 "[debug]: infer %s\n" (Print.term_to_string e); let mk x = mk x e.pos in - let normalize = N.normalize [ Env.Beta; Env.Eager_unfolding; Env.UnfoldUntil S.delta_constant; Env.EraseUniverses ] env.tcenv in + let normalize = N.normalize [ Env.Beta; Env.Eager_unfolding; Env.UnfoldTac; Env.UnfoldUntil S.delta_constant; Env.EraseUniverses ] env.tcenv in match (SS.compress e).n with | Tm_bvar bv -> failwith "I failed to open a binder... boo" @@ -976,7 +976,7 @@ and infer (env: env) (e: term): nm * term * term = Some rc | Some rt -> - let rt = N.normalize [ Env.Beta; Env.Eager_unfolding; Env.UnfoldUntil S.delta_constant; Env.EraseUniverses ] (get_env env) rt in + let rt = N.normalize [ Env.Beta; Env.Eager_unfolding; Env.UnfoldTac; Env.UnfoldUntil S.delta_constant; Env.EraseUniverses ] (get_env env) rt in if rc.residual_flags |> BU.for_some (function CPS -> true | _ -> false) then let flags = List.filter (function CPS -> false | _ -> true) rc.residual_flags in @@ -1346,7 +1346,7 @@ and trans_G (env: env_) (h: typ) (is_monadic: bool) (wp: typ): comp = // A helper -------------------------------------------------------------------- (* KM : why is there both NoDeltaSteps and UnfoldUntil Delta_constant ? *) -let n = N.normalize [ Env.Beta; Env.UnfoldUntil delta_constant; Env.DoNotUnfoldPureLets; Env.Eager_unfolding; Env.EraseUniverses ] +let n = N.normalize [ Env.UnfoldTac; Env.Beta; Env.UnfoldUntil delta_constant; Env.DoNotUnfoldPureLets; Env.Eager_unfolding; Env.EraseUniverses ] // Exported definitions ------------------------------------------------------- From 988584448f52ec959cf9f832882a29e23fced6c8 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Fri, 26 Apr 2024 14:58:07 -0700 Subject: [PATCH 112/239] refactor to provide an environment to eq_tm and NBETerm.eq_t --- .../generated/FStar_SMTEncoding_Encode.ml | 14 +- .../fstar-lib/generated/FStar_Syntax_Util.ml | 542 ++----- .../generated/FStar_Tactics_Hooks.ml | 7 +- .../generated/FStar_TypeChecker_Cfg.ml | 18 +- .../generated/FStar_TypeChecker_Common.ml | 887 ----------- .../generated/FStar_TypeChecker_Core.ml | 10 +- .../generated/FStar_TypeChecker_DMFF.ml | 2 +- .../FStar_TypeChecker_DeferredImplicits.ml | 13 +- .../generated/FStar_TypeChecker_NBE.ml | 19 +- .../generated/FStar_TypeChecker_NBETerm.ml | 217 +-- .../generated/FStar_TypeChecker_Normalize.ml | 34 +- .../FStar_TypeChecker_Normalize_Unfolding.ml | 3 +- .../generated/FStar_TypeChecker_Primops.ml | 13 +- .../generated/FStar_TypeChecker_Primops_Eq.ml | 365 ++--- .../generated/FStar_TypeChecker_Rel.ml | 252 ++-- .../generated/FStar_TypeChecker_TcEffect.ml | 49 +- .../generated/FStar_TypeChecker_TcTerm.ml | 21 +- .../FStar_TypeChecker_TermEqAndSimplify.ml | 1303 +++++++++++++++++ .../generated/FStar_TypeChecker_Util.ml | 15 +- .../fstar-tests/generated/FStar_Tests_Util.ml | 5 +- src/smtencoding/FStar.SMTEncoding.Encode.fst | 7 +- src/syntax/FStar.Syntax.Util.fst | 643 ++++---- src/tactics/FStar.Tactics.Hooks.fst | 3 +- src/tests/FStar.Tests.Util.fst | 2 +- src/typechecker/FStar.TypeChecker.Cfg.fst | 5 +- src/typechecker/FStar.TypeChecker.Cfg.fsti | 2 +- src/typechecker/FStar.TypeChecker.Common.fst | 264 ---- src/typechecker/FStar.TypeChecker.Common.fsti | 1 - src/typechecker/FStar.TypeChecker.Core.fst | 4 +- src/typechecker/FStar.TypeChecker.DMFF.fst | 3 +- .../FStar.TypeChecker.DeferredImplicits.fst | 5 +- src/typechecker/FStar.TypeChecker.NBE.fst | 11 +- src/typechecker/FStar.TypeChecker.NBETerm.fst | 68 +- .../FStar.TypeChecker.NBETerm.fsti | 4 +- .../FStar.TypeChecker.Normalize.Unfolding.fst | 4 +- .../FStar.TypeChecker.Normalize.fst | 6 +- .../FStar.TypeChecker.Primops.Base.fsti | 2 +- .../FStar.TypeChecker.Primops.Eq.fst | 68 +- .../FStar.TypeChecker.Primops.Eq.fsti | 6 +- src/typechecker/FStar.TypeChecker.Primops.fst | 7 +- .../FStar.TypeChecker.Primops.fsti | 3 +- src/typechecker/FStar.TypeChecker.Rel.fst | 31 +- .../FStar.TypeChecker.TcEffect.fst | 21 +- src/typechecker/FStar.TypeChecker.TcTerm.fst | 9 +- .../FStar.TypeChecker.TermEqAndSimplify.fst | 531 +++++++ .../FStar.TypeChecker.TermEqAndSimplify.fsti | 16 + src/typechecker/FStar.TypeChecker.Util.fst | 5 +- 47 files changed, 3047 insertions(+), 2473 deletions(-) create mode 100644 ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml create mode 100644 src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst create mode 100644 src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fsti diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index d6c777432c3..bd30c5cf7e8 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -5170,17 +5170,18 @@ let (encode_datacon : -> let uu___37 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env1.FStar_SMTEncoding_Env.tcenv head1 head' in (match uu___37 with | - FStar_Syntax_Util.Equal + FStar_TypeChecker_TermEqAndSimplify.Equal -> FStar_Pervasives_Native.None | - FStar_Syntax_Util.NotEqual + FStar_TypeChecker_TermEqAndSimplify.NotEqual -> binder_and_codomain_type t' @@ -5913,17 +5914,18 @@ let (encode_datacon : -> let uu___33 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env1.FStar_SMTEncoding_Env.tcenv head1 head' in (match uu___33 with | - FStar_Syntax_Util.Equal + FStar_TypeChecker_TermEqAndSimplify.Equal -> FStar_Pervasives_Native.None | - FStar_Syntax_Util.NotEqual + FStar_TypeChecker_TermEqAndSimplify.NotEqual -> binder_and_codomain_type t' diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml index 7ddadaffc7d..20334fc76d1 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml @@ -382,6 +382,14 @@ let (eq_univs : = fun u1 -> fun u2 -> let uu___ = compare_univs u1 u2 in uu___ = Prims.int_zero +let (eq_univs_list : + FStar_Syntax_Syntax.universes -> + FStar_Syntax_Syntax.universes -> Prims.bool) + = + fun us -> + fun vs -> + ((FStar_Compiler_List.length us) = (FStar_Compiler_List.length vs)) && + (FStar_Compiler_List.forall2 eq_univs us vs) let (ml_comp : FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> FStar_Compiler_Range_Type.range -> FStar_Syntax_Syntax.comp) @@ -929,418 +937,6 @@ let (canon_app : match uu___ with | (hd, args) -> FStar_Syntax_Syntax.mk_Tm_app hd args t.FStar_Syntax_Syntax.pos -type eq_result = - | Equal - | NotEqual - | Unknown -let (uu___is_Equal : eq_result -> Prims.bool) = - fun projectee -> match projectee with | Equal -> true | uu___ -> false -let (uu___is_NotEqual : eq_result -> Prims.bool) = - fun projectee -> match projectee with | NotEqual -> true | uu___ -> false -let (uu___is_Unknown : eq_result -> Prims.bool) = - fun projectee -> match projectee with | Unknown -> true | uu___ -> false -let (injectives : Prims.string Prims.list) = - ["FStar.Int8.int_to_t"; - "FStar.Int16.int_to_t"; - "FStar.Int32.int_to_t"; - "FStar.Int64.int_to_t"; - "FStar.Int128.int_to_t"; - "FStar.UInt8.uint_to_t"; - "FStar.UInt16.uint_to_t"; - "FStar.UInt32.uint_to_t"; - "FStar.UInt64.uint_to_t"; - "FStar.UInt128.uint_to_t"; - "FStar.SizeT.uint_to_t"; - "FStar.Int8.__int_to_t"; - "FStar.Int16.__int_to_t"; - "FStar.Int32.__int_to_t"; - "FStar.Int64.__int_to_t"; - "FStar.Int128.__int_to_t"; - "FStar.UInt8.__uint_to_t"; - "FStar.UInt16.__uint_to_t"; - "FStar.UInt32.__uint_to_t"; - "FStar.UInt64.__uint_to_t"; - "FStar.UInt128.__uint_to_t"; - "FStar.SizeT.__uint_to_t"] -let (eq_inj : eq_result -> eq_result -> eq_result) = - fun r -> - fun s -> - match (r, s) with - | (Equal, Equal) -> Equal - | (NotEqual, uu___) -> NotEqual - | (uu___, NotEqual) -> NotEqual - | (uu___, uu___1) -> Unknown -let (equal_if : Prims.bool -> eq_result) = - fun uu___ -> if uu___ then Equal else Unknown -let (equal_iff : Prims.bool -> eq_result) = - fun uu___ -> if uu___ then Equal else NotEqual -let (eq_and : eq_result -> (unit -> eq_result) -> eq_result) = - fun r -> - fun s -> - let uu___ = (r = Equal) && (let uu___1 = s () in uu___1 = Equal) in - if uu___ then Equal else Unknown -let rec (eq_tm : - FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> eq_result) = - fun t1 -> - fun t2 -> - let t11 = canon_app t1 in - let t21 = canon_app t2 in - let equal_data f1 args1 f2 args2 = - let uu___ = FStar_Syntax_Syntax.fv_eq f1 f2 in - if uu___ - then - let uu___1 = FStar_Compiler_List.zip args1 args2 in - FStar_Compiler_List.fold_left - (fun acc -> - fun uu___2 -> - match uu___2 with - | ((a1, q1), (a2, q2)) -> - let uu___3 = eq_tm a1 a2 in eq_inj acc uu___3) Equal - uu___1 - else NotEqual in - let qual_is_inj uu___ = - match uu___ with - | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Data_ctor) -> - true - | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor - uu___1) -> true - | uu___1 -> false in - let heads_and_args_in_case_both_data = - let uu___ = let uu___1 = unmeta t11 in head_and_args uu___1 in - match uu___ with - | (head1, args1) -> - let uu___1 = let uu___2 = unmeta t21 in head_and_args uu___2 in - (match uu___1 with - | (head2, args2) -> - let uu___2 = - let uu___3 = - let uu___4 = un_uinst head1 in - uu___4.FStar_Syntax_Syntax.n in - let uu___4 = - let uu___5 = un_uinst head2 in - uu___5.FStar_Syntax_Syntax.n in - (uu___3, uu___4) in - (match uu___2 with - | (FStar_Syntax_Syntax.Tm_fvar f, - FStar_Syntax_Syntax.Tm_fvar g) when - (qual_is_inj f.FStar_Syntax_Syntax.fv_qual) && - (qual_is_inj g.FStar_Syntax_Syntax.fv_qual) - -> FStar_Pervasives_Native.Some (f, args1, g, args2) - | uu___3 -> FStar_Pervasives_Native.None)) in - let t12 = unmeta t11 in - let t22 = unmeta t21 in - match ((t12.FStar_Syntax_Syntax.n), (t22.FStar_Syntax_Syntax.n)) with - | (FStar_Syntax_Syntax.Tm_bvar bv1, FStar_Syntax_Syntax.Tm_bvar bv2) -> - equal_if - (bv1.FStar_Syntax_Syntax.index = bv2.FStar_Syntax_Syntax.index) - | (FStar_Syntax_Syntax.Tm_lazy uu___, uu___1) -> - let uu___2 = unlazy t12 in eq_tm uu___2 t22 - | (uu___, FStar_Syntax_Syntax.Tm_lazy uu___1) -> - let uu___2 = unlazy t22 in eq_tm t12 uu___2 - | (FStar_Syntax_Syntax.Tm_name a, FStar_Syntax_Syntax.Tm_name b) -> - let uu___ = FStar_Syntax_Syntax.bv_eq a b in equal_if uu___ - | uu___ when - FStar_Compiler_Util.is_some heads_and_args_in_case_both_data -> - let uu___1 = - FStar_Compiler_Util.must heads_and_args_in_case_both_data in - (match uu___1 with - | (f, args1, g, args2) -> equal_data f args1 g args2) - | (FStar_Syntax_Syntax.Tm_fvar f, FStar_Syntax_Syntax.Tm_fvar g) -> - let uu___ = FStar_Syntax_Syntax.fv_eq f g in equal_if uu___ - | (FStar_Syntax_Syntax.Tm_uinst (f, us), FStar_Syntax_Syntax.Tm_uinst - (g, vs)) -> - let uu___ = eq_tm f g in - eq_and uu___ - (fun uu___1 -> - let uu___2 = eq_univs_list us vs in equal_if uu___2) - | (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range uu___), - FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range uu___1)) -> - Unknown - | (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_real r1), - FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_real r2)) -> - equal_if (r1 = r2) - | (FStar_Syntax_Syntax.Tm_constant c, FStar_Syntax_Syntax.Tm_constant - d) -> let uu___ = FStar_Const.eq_const c d in equal_iff uu___ - | (FStar_Syntax_Syntax.Tm_uvar (u1, ([], uu___)), - FStar_Syntax_Syntax.Tm_uvar (u2, ([], uu___1))) -> - let uu___2 = - FStar_Syntax_Unionfind.equiv u1.FStar_Syntax_Syntax.ctx_uvar_head - u2.FStar_Syntax_Syntax.ctx_uvar_head in - equal_if uu___2 - | (FStar_Syntax_Syntax.Tm_app - { FStar_Syntax_Syntax.hd = h1; FStar_Syntax_Syntax.args = args1;_}, - FStar_Syntax_Syntax.Tm_app - { FStar_Syntax_Syntax.hd = h2; FStar_Syntax_Syntax.args = args2;_}) - -> - let uu___ = - let uu___1 = - let uu___2 = un_uinst h1 in uu___2.FStar_Syntax_Syntax.n in - let uu___2 = - let uu___3 = un_uinst h2 in uu___3.FStar_Syntax_Syntax.n in - (uu___1, uu___2) in - (match uu___ with - | (FStar_Syntax_Syntax.Tm_fvar f1, FStar_Syntax_Syntax.Tm_fvar f2) - when - (FStar_Syntax_Syntax.fv_eq f1 f2) && - (let uu___1 = - let uu___2 = FStar_Syntax_Syntax.lid_of_fv f1 in - FStar_Ident.string_of_lid uu___2 in - FStar_Compiler_List.mem uu___1 injectives) - -> equal_data f1 args1 f2 args2 - | uu___1 -> - let uu___2 = eq_tm h1 h2 in - eq_and uu___2 (fun uu___3 -> eq_args args1 args2)) - | (FStar_Syntax_Syntax.Tm_match - { FStar_Syntax_Syntax.scrutinee = t13; - FStar_Syntax_Syntax.ret_opt = uu___; - FStar_Syntax_Syntax.brs = bs1; - FStar_Syntax_Syntax.rc_opt1 = uu___1;_}, - FStar_Syntax_Syntax.Tm_match - { FStar_Syntax_Syntax.scrutinee = t23; - FStar_Syntax_Syntax.ret_opt = uu___2; - FStar_Syntax_Syntax.brs = bs2; - FStar_Syntax_Syntax.rc_opt1 = uu___3;_}) - -> - if - (FStar_Compiler_List.length bs1) = - (FStar_Compiler_List.length bs2) - then - let uu___4 = FStar_Compiler_List.zip bs1 bs2 in - let uu___5 = eq_tm t13 t23 in - FStar_Compiler_List.fold_right - (fun uu___6 -> - fun a -> - match uu___6 with - | (b1, b2) -> - eq_and a (fun uu___7 -> branch_matches b1 b2)) uu___4 - uu___5 - else Unknown - | (FStar_Syntax_Syntax.Tm_type u, FStar_Syntax_Syntax.Tm_type v) -> - let uu___ = eq_univs u v in equal_if uu___ - | (FStar_Syntax_Syntax.Tm_quoted (t13, q1), - FStar_Syntax_Syntax.Tm_quoted (t23, q2)) -> Unknown - | (FStar_Syntax_Syntax.Tm_refine - { FStar_Syntax_Syntax.b = t13; FStar_Syntax_Syntax.phi = phi1;_}, - FStar_Syntax_Syntax.Tm_refine - { FStar_Syntax_Syntax.b = t23; FStar_Syntax_Syntax.phi = phi2;_}) -> - let uu___ = - eq_tm t13.FStar_Syntax_Syntax.sort t23.FStar_Syntax_Syntax.sort in - eq_and uu___ (fun uu___1 -> eq_tm phi1 phi2) - | (FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = bs1; FStar_Syntax_Syntax.body = body1; - FStar_Syntax_Syntax.rc_opt = uu___;_}, - FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = bs2; FStar_Syntax_Syntax.body = body2; - FStar_Syntax_Syntax.rc_opt = uu___1;_}) - when - (FStar_Compiler_List.length bs1) = (FStar_Compiler_List.length bs2) - -> - let uu___2 = - FStar_Compiler_List.fold_left2 - (fun r -> - fun b1 -> - fun b2 -> - eq_and r - (fun uu___3 -> - eq_tm - (b1.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort - (b2.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort)) - Equal bs1 bs2 in - eq_and uu___2 (fun uu___3 -> eq_tm body1 body2) - | (FStar_Syntax_Syntax.Tm_arrow - { FStar_Syntax_Syntax.bs1 = bs1; FStar_Syntax_Syntax.comp = c1;_}, - FStar_Syntax_Syntax.Tm_arrow - { FStar_Syntax_Syntax.bs1 = bs2; FStar_Syntax_Syntax.comp = c2;_}) - when - (FStar_Compiler_List.length bs1) = (FStar_Compiler_List.length bs2) - -> - let uu___ = - FStar_Compiler_List.fold_left2 - (fun r -> - fun b1 -> - fun b2 -> - eq_and r - (fun uu___1 -> - eq_tm - (b1.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort - (b2.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort)) - Equal bs1 bs2 in - eq_and uu___ (fun uu___1 -> eq_comp c1 c2) - | uu___ -> Unknown -and (eq_antiquotations : - FStar_Syntax_Syntax.term Prims.list -> - FStar_Syntax_Syntax.term Prims.list -> eq_result) - = - fun a1 -> - fun a2 -> - match (a1, a2) with - | ([], []) -> Equal - | ([], uu___) -> NotEqual - | (uu___, []) -> NotEqual - | (t1::a11, t2::a21) -> - let uu___ = eq_tm t1 t2 in - (match uu___ with - | NotEqual -> NotEqual - | Unknown -> - let uu___1 = eq_antiquotations a11 a21 in - (match uu___1 with | NotEqual -> NotEqual | uu___2 -> Unknown) - | Equal -> eq_antiquotations a11 a21) -and (branch_matches : - (FStar_Syntax_Syntax.pat' FStar_Syntax_Syntax.withinfo_t * - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax - FStar_Pervasives_Native.option * FStar_Syntax_Syntax.term' - FStar_Syntax_Syntax.syntax) -> - (FStar_Syntax_Syntax.pat' FStar_Syntax_Syntax.withinfo_t * - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax - FStar_Pervasives_Native.option * FStar_Syntax_Syntax.term' - FStar_Syntax_Syntax.syntax) -> eq_result) - = - fun b1 -> - fun b2 -> - let related_by f o1 o2 = - match (o1, o2) with - | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> - true - | (FStar_Pervasives_Native.Some x, FStar_Pervasives_Native.Some y) -> - f x y - | (uu___, uu___1) -> false in - let uu___ = b1 in - match uu___ with - | (p1, w1, t1) -> - let uu___1 = b2 in - (match uu___1 with - | (p2, w2, t2) -> - let uu___2 = FStar_Syntax_Syntax.eq_pat p1 p2 in - if uu___2 - then - let uu___3 = - (let uu___4 = eq_tm t1 t2 in uu___4 = Equal) && - (related_by - (fun t11 -> - fun t21 -> - let uu___4 = eq_tm t11 t21 in uu___4 = Equal) w1 - w2) in - (if uu___3 then Equal else Unknown) - else Unknown) -and (eq_args : - FStar_Syntax_Syntax.args -> FStar_Syntax_Syntax.args -> eq_result) = - fun a1 -> - fun a2 -> - match (a1, a2) with - | ([], []) -> Equal - | ((a, uu___)::a11, (b, uu___1)::b1) -> - let uu___2 = eq_tm a b in - (match uu___2 with | Equal -> eq_args a11 b1 | uu___3 -> Unknown) - | uu___ -> Unknown -and (eq_univs_list : - FStar_Syntax_Syntax.universes -> - FStar_Syntax_Syntax.universes -> Prims.bool) - = - fun us -> - fun vs -> - ((FStar_Compiler_List.length us) = (FStar_Compiler_List.length vs)) && - (FStar_Compiler_List.forall2 eq_univs us vs) -and (eq_comp : - FStar_Syntax_Syntax.comp -> FStar_Syntax_Syntax.comp -> eq_result) = - fun c1 -> - fun c2 -> - match ((c1.FStar_Syntax_Syntax.n), (c2.FStar_Syntax_Syntax.n)) with - | (FStar_Syntax_Syntax.Total t1, FStar_Syntax_Syntax.Total t2) -> - eq_tm t1 t2 - | (FStar_Syntax_Syntax.GTotal t1, FStar_Syntax_Syntax.GTotal t2) -> - eq_tm t1 t2 - | (FStar_Syntax_Syntax.Comp ct1, FStar_Syntax_Syntax.Comp ct2) -> - let uu___ = - let uu___1 = - eq_univs_list ct1.FStar_Syntax_Syntax.comp_univs - ct2.FStar_Syntax_Syntax.comp_univs in - equal_if uu___1 in - eq_and uu___ - (fun uu___1 -> - let uu___2 = - let uu___3 = - FStar_Ident.lid_equals ct1.FStar_Syntax_Syntax.effect_name - ct2.FStar_Syntax_Syntax.effect_name in - equal_if uu___3 in - eq_and uu___2 - (fun uu___3 -> - let uu___4 = - eq_tm ct1.FStar_Syntax_Syntax.result_typ - ct2.FStar_Syntax_Syntax.result_typ in - eq_and uu___4 - (fun uu___5 -> - eq_args ct1.FStar_Syntax_Syntax.effect_args - ct2.FStar_Syntax_Syntax.effect_args))) - | uu___ -> NotEqual -let (eq_quoteinfo : - FStar_Syntax_Syntax.quoteinfo -> FStar_Syntax_Syntax.quoteinfo -> eq_result) - = - fun q1 -> - fun q2 -> - if q1.FStar_Syntax_Syntax.qkind <> q2.FStar_Syntax_Syntax.qkind - then NotEqual - else - eq_antiquotations - (FStar_Pervasives_Native.snd q1.FStar_Syntax_Syntax.antiquotations) - (FStar_Pervasives_Native.snd q2.FStar_Syntax_Syntax.antiquotations) -let (eq_bqual : - FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> - FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> - eq_result) - = - fun a1 -> - fun a2 -> - match (a1, a2) with - | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> Equal - | (FStar_Pervasives_Native.None, uu___) -> NotEqual - | (uu___, FStar_Pervasives_Native.None) -> NotEqual - | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit b1), - FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit b2)) when - b1 = b2 -> Equal - | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Meta t1), - FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Meta t2)) -> - eq_tm t1 t2 - | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Equality), - FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Equality)) -> - Equal - | uu___ -> NotEqual -let (eq_aqual : - FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> - FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> - eq_result) - = - fun a1 -> - fun a2 -> - match (a1, a2) with - | (FStar_Pervasives_Native.Some a11, FStar_Pervasives_Native.Some a21) - -> - if - (a11.FStar_Syntax_Syntax.aqual_implicit = - a21.FStar_Syntax_Syntax.aqual_implicit) - && - ((FStar_Compiler_List.length - a11.FStar_Syntax_Syntax.aqual_attributes) - = - (FStar_Compiler_List.length - a21.FStar_Syntax_Syntax.aqual_attributes)) - then - FStar_Compiler_List.fold_left2 - (fun out -> - fun t1 -> - fun t2 -> - match out with - | NotEqual -> out - | Unknown -> - let uu___ = eq_tm t1 t2 in - (match uu___ with - | NotEqual -> NotEqual - | uu___1 -> Unknown) - | Equal -> eq_tm t1 t2) Equal - a11.FStar_Syntax_Syntax.aqual_attributes - a21.FStar_Syntax_Syntax.aqual_attributes - else NotEqual - | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> Equal - | uu___ -> NotEqual let rec (unrefine : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term) = fun t -> let t1 = FStar_Syntax_Subst.compress t in @@ -2339,12 +1935,6 @@ let (type_with_u : FStar_Syntax_Syntax.universe -> FStar_Syntax_Syntax.typ) = fun u -> FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_type u) FStar_Compiler_Range_Type.dummyRange -let (attr_eq : - FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> Prims.bool) = - fun a -> - fun a' -> - let uu___ = eq_tm a a' in - match uu___ with | Equal -> true | uu___1 -> false let (attr_substitute : FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax) = let uu___ = @@ -3658,7 +3248,7 @@ let rec (term_eq_dbg : u2.FStar_Syntax_Syntax.ctx_uvar_head) | (FStar_Syntax_Syntax.Tm_quoted (qt1, qi1), FStar_Syntax_Syntax.Tm_quoted (qt2, qi2)) -> - (let uu___1 = let uu___2 = eq_quoteinfo qi1 qi2 in uu___2 = Equal in + (let uu___1 = quote_info_eq_dbg dbg qi1 qi2 in check1 "tm_quoted qi" uu___1) && (let uu___1 = term_eq_dbg dbg qt1 qt2 in check1 "tm_quoted payload" uu___1) @@ -3729,7 +3319,7 @@ and (arg_eq_dbg : let uu___ = term_eq_dbg dbg t1 t2 in check dbg "arg tm" uu___) (fun q1 -> fun q2 -> - let uu___ = let uu___1 = eq_aqual q1 q2 in uu___1 = Equal in + let uu___ = aqual_eq_dbg dbg q1 q2 in check dbg "arg qual" uu___) a1 a2 and (binder_eq_dbg : Prims.bool -> @@ -3744,10 +3334,8 @@ and (binder_eq_dbg : (b2.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in check dbg "binder_sort" uu___) && (let uu___ = - let uu___1 = - eq_bqual b1.FStar_Syntax_Syntax.binder_qual - b2.FStar_Syntax_Syntax.binder_qual in - uu___1 = Equal in + bqual_eq_dbg dbg b1.FStar_Syntax_Syntax.binder_qual + b2.FStar_Syntax_Syntax.binder_qual in check dbg "binder qual" uu___)) && (let uu___ = @@ -3823,6 +3411,108 @@ and (letbinding_eq_dbg : term_eq_dbg dbg lb1.FStar_Syntax_Syntax.lbdef lb2.FStar_Syntax_Syntax.lbdef in check dbg "lb def" uu___) +and (quote_info_eq_dbg : + Prims.bool -> + FStar_Syntax_Syntax.quoteinfo -> + FStar_Syntax_Syntax.quoteinfo -> Prims.bool) + = + fun dbg -> + fun q1 -> + fun q2 -> + if q1.FStar_Syntax_Syntax.qkind <> q2.FStar_Syntax_Syntax.qkind + then false + else + antiquotations_eq_dbg dbg + (FStar_Pervasives_Native.snd + q1.FStar_Syntax_Syntax.antiquotations) + (FStar_Pervasives_Native.snd + q2.FStar_Syntax_Syntax.antiquotations) +and (antiquotations_eq_dbg : + Prims.bool -> + FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax Prims.list -> + FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax Prims.list -> + Prims.bool) + = + fun dbg -> + fun a1 -> + fun a2 -> + match (a1, a2) with + | ([], []) -> true + | ([], uu___) -> false + | (uu___, []) -> false + | (t1::a11, t2::a21) -> + let uu___ = + let uu___1 = term_eq_dbg dbg t1 t2 in Prims.op_Negation uu___1 in + if uu___ then false else antiquotations_eq_dbg dbg a11 a21 +and (bqual_eq_dbg : + Prims.bool -> + FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> + FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> + Prims.bool) + = + fun dbg -> + fun a1 -> + fun a2 -> + match (a1, a2) with + | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> + true + | (FStar_Pervasives_Native.None, uu___) -> false + | (uu___, FStar_Pervasives_Native.None) -> false + | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit b1), + FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit b2)) + when b1 = b2 -> true + | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Meta t1), + FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Meta t2)) -> + term_eq_dbg dbg t1 t2 + | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Equality), + FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Equality)) -> + true + | uu___ -> false +and (aqual_eq_dbg : + Prims.bool -> + FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> + FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> + Prims.bool) + = + fun dbg -> + fun a1 -> + fun a2 -> + match (a1, a2) with + | (FStar_Pervasives_Native.Some a11, FStar_Pervasives_Native.Some + a21) -> + if + (a11.FStar_Syntax_Syntax.aqual_implicit = + a21.FStar_Syntax_Syntax.aqual_implicit) + && + ((FStar_Compiler_List.length + a11.FStar_Syntax_Syntax.aqual_attributes) + = + (FStar_Compiler_List.length + a21.FStar_Syntax_Syntax.aqual_attributes)) + then + FStar_Compiler_List.fold_left2 + (fun out -> + fun t1 -> + fun t2 -> + if Prims.op_Negation out + then false + else term_eq_dbg dbg t1 t2) true + a11.FStar_Syntax_Syntax.aqual_attributes + a21.FStar_Syntax_Syntax.aqual_attributes + else false + | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> + true + | uu___ -> false +let (eq_aqual : + FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> + FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> + Prims.bool) + = fun a1 -> fun a2 -> aqual_eq_dbg false a1 a2 +let (eq_bqual : + FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> + FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> + Prims.bool) + = fun b1 -> fun b2 -> bqual_eq_dbg false b1 b2 let (term_eq : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> Prims.bool) = fun t1 -> @@ -4912,9 +4602,7 @@ let (is_binder_unused : FStar_Syntax_Syntax.binder -> Prims.bool) = let (deduplicate_terms : FStar_Syntax_Syntax.term Prims.list -> FStar_Syntax_Syntax.term Prims.list) = - fun l -> - FStar_Compiler_List.deduplicate - (fun x -> fun y -> let uu___ = eq_tm x y in uu___ = Equal) l + fun l -> FStar_Compiler_List.deduplicate (fun x -> fun y -> term_eq x y) l let (eq_binding : FStar_Syntax_Syntax.binding -> FStar_Syntax_Syntax.binding -> Prims.bool) = fun b1 -> diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml index 13327a01148..85ce3f884e7 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml @@ -1261,9 +1261,10 @@ let rec (traverse_for_spinoff : FStar_Parser_Const.squash_lid)) && (let uu___8 = - FStar_Syntax_Util.eq_tm t2 - FStar_Syntax_Util.t_true in - uu___8 = FStar_Syntax_Util.Equal) + FStar_TypeChecker_TermEqAndSimplify.eq_tm + e t2 FStar_Syntax_Util.t_true in + uu___8 = + FStar_TypeChecker_TermEqAndSimplify.Equal) -> (if debug then diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Cfg.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Cfg.ml index caf64d7bfe2..d7ade7dd769 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Cfg.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Cfg.ml @@ -2190,9 +2190,17 @@ let (prim_from_list : let (built_in_primitive_steps : FStar_TypeChecker_Primops_Base.primitive_step FStar_Compiler_Util.psmap) = prim_from_list FStar_TypeChecker_Primops.built_in_primitive_steps_list +let (env_dependent_ops : FStar_TypeChecker_Env.env_t -> prim_step_set) = + fun env -> + let uu___ = FStar_TypeChecker_Primops.env_dependent_ops env in + prim_from_list uu___ let (equality_ops : - FStar_TypeChecker_Primops_Base.primitive_step FStar_Compiler_Util.psmap) = - prim_from_list FStar_TypeChecker_Primops.equality_ops_list + FStar_TypeChecker_Env.env_t -> + FStar_TypeChecker_Primops_Base.primitive_step FStar_Compiler_Util.psmap) + = + fun env -> + let uu___ = FStar_TypeChecker_Primops.equality_ops_list env in + prim_from_list uu___ let (showable_cfg : cfg FStar_Class_Show.showable) = { FStar_Class_Show.show = @@ -2414,7 +2422,11 @@ let (config' : let d1 = match d with | [] -> [FStar_TypeChecker_Env.NoDelta] | uu___ -> d in let steps = let uu___ = to_fsteps s in add_nbe uu___ in - let psteps1 = let uu___ = cached_steps () in add_steps uu___ psteps in + let psteps1 = + let uu___ = + let uu___1 = cached_steps () in + let uu___2 = env_dependent_ops e in merge_steps uu___1 uu___2 in + add_steps uu___ psteps in let dbg_flag = FStar_Compiler_List.contains FStar_TypeChecker_Env.NormDebug s in let uu___ = diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Common.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Common.ml index 456504c264b..10fe85caf67 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Common.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Common.ml @@ -914,893 +914,6 @@ let (lcomp_of_comp_guard : FStar_Syntax_Syntax.comp -> guard_t -> lcomp) = (fun uu___1 -> (c0, g)) let (lcomp_of_comp : FStar_Syntax_Syntax.comp -> lcomp) = fun c0 -> lcomp_of_comp_guard c0 trivial_guard -let (simplify : - Prims.bool -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term) = - fun debug -> - fun tm -> - let w t = - { - FStar_Syntax_Syntax.n = (t.FStar_Syntax_Syntax.n); - FStar_Syntax_Syntax.pos = (tm.FStar_Syntax_Syntax.pos); - FStar_Syntax_Syntax.vars = (t.FStar_Syntax_Syntax.vars); - FStar_Syntax_Syntax.hash_code = (t.FStar_Syntax_Syntax.hash_code) - } in - let simp_t t = - let uu___ = - let uu___1 = FStar_Syntax_Util.unmeta t in - uu___1.FStar_Syntax_Syntax.n in - match uu___ with - | FStar_Syntax_Syntax.Tm_fvar fv when - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.true_lid -> - FStar_Pervasives_Native.Some true - | FStar_Syntax_Syntax.Tm_fvar fv when - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.false_lid -> - FStar_Pervasives_Native.Some false - | uu___1 -> FStar_Pervasives_Native.None in - let rec args_are_binders args bs = - match (args, bs) with - | ((t, uu___)::args1, b::bs1) -> - let uu___1 = - let uu___2 = FStar_Syntax_Subst.compress t in - uu___2.FStar_Syntax_Syntax.n in - (match uu___1 with - | FStar_Syntax_Syntax.Tm_name bv' -> - (FStar_Syntax_Syntax.bv_eq b.FStar_Syntax_Syntax.binder_bv - bv') - && (args_are_binders args1 bs1) - | uu___2 -> false) - | ([], []) -> true - | (uu___, uu___1) -> false in - let is_applied bs t = - if debug - then - (let uu___1 = FStar_Syntax_Print.term_to_string t in - let uu___2 = FStar_Syntax_Print.tag_of_term t in - FStar_Compiler_Util.print2 "WPE> is_applied %s -- %s\n" uu___1 - uu___2) - else (); - (let uu___1 = FStar_Syntax_Util.head_and_args_full t in - match uu___1 with - | (hd, args) -> - let uu___2 = - let uu___3 = FStar_Syntax_Subst.compress hd in - uu___3.FStar_Syntax_Syntax.n in - (match uu___2 with - | FStar_Syntax_Syntax.Tm_name bv when args_are_binders args bs - -> - (if debug - then - (let uu___4 = FStar_Syntax_Print.term_to_string t in - let uu___5 = FStar_Syntax_Print.bv_to_string bv in - let uu___6 = FStar_Syntax_Print.term_to_string hd in - FStar_Compiler_Util.print3 - "WPE> got it\n>>>>top = %s\n>>>>b = %s\n>>>>hd = %s\n" - uu___4 uu___5 uu___6) - else (); - FStar_Pervasives_Native.Some bv) - | uu___3 -> FStar_Pervasives_Native.None)) in - let is_applied_maybe_squashed bs t = - if debug - then - (let uu___1 = FStar_Syntax_Print.term_to_string t in - let uu___2 = FStar_Syntax_Print.tag_of_term t in - FStar_Compiler_Util.print2 - "WPE> is_applied_maybe_squashed %s -- %s\n" uu___1 uu___2) - else (); - (let uu___1 = FStar_Syntax_Util.is_squash t in - match uu___1 with - | FStar_Pervasives_Native.Some (uu___2, t') -> is_applied bs t' - | uu___2 -> - let uu___3 = FStar_Syntax_Util.is_auto_squash t in - (match uu___3 with - | FStar_Pervasives_Native.Some (uu___4, t') -> is_applied bs t' - | uu___4 -> is_applied bs t)) in - let is_const_match phi = - let uu___ = - let uu___1 = FStar_Syntax_Subst.compress phi in - uu___1.FStar_Syntax_Syntax.n in - match uu___ with - | FStar_Syntax_Syntax.Tm_match - { FStar_Syntax_Syntax.scrutinee = uu___1; - FStar_Syntax_Syntax.ret_opt = uu___2; - FStar_Syntax_Syntax.brs = br::brs; - FStar_Syntax_Syntax.rc_opt1 = uu___3;_} - -> - let uu___4 = br in - (match uu___4 with - | (uu___5, uu___6, e) -> - let r = - let uu___7 = simp_t e in - match uu___7 with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some b -> - let uu___8 = - FStar_Compiler_List.for_all - (fun uu___9 -> - match uu___9 with - | (uu___10, uu___11, e') -> - let uu___12 = simp_t e' in - uu___12 = (FStar_Pervasives_Native.Some b)) - brs in - if uu___8 - then FStar_Pervasives_Native.Some b - else FStar_Pervasives_Native.None in - r) - | uu___1 -> FStar_Pervasives_Native.None in - let maybe_auto_squash t = - let uu___ = FStar_Syntax_Util.is_sub_singleton t in - if uu___ - then t - else FStar_Syntax_Util.mk_auto_squash FStar_Syntax_Syntax.U_zero t in - let squashed_head_un_auto_squash_args t = - let maybe_un_auto_squash_arg uu___ = - match uu___ with - | (t1, q) -> - let uu___1 = FStar_Syntax_Util.is_auto_squash t1 in - (match uu___1 with - | FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.U_zero, t2) -> (t2, q) - | uu___2 -> (t1, q)) in - let uu___ = FStar_Syntax_Util.head_and_args t in - match uu___ with - | (head, args) -> - let args1 = FStar_Compiler_List.map maybe_un_auto_squash_arg args in - FStar_Syntax_Syntax.mk_Tm_app head args1 - t.FStar_Syntax_Syntax.pos in - let rec clearly_inhabited ty = - let uu___ = - let uu___1 = FStar_Syntax_Util.unmeta ty in - uu___1.FStar_Syntax_Syntax.n in - match uu___ with - | FStar_Syntax_Syntax.Tm_uinst (t, uu___1) -> clearly_inhabited t - | FStar_Syntax_Syntax.Tm_arrow - { FStar_Syntax_Syntax.bs1 = uu___1; - FStar_Syntax_Syntax.comp = c;_} - -> clearly_inhabited (FStar_Syntax_Util.comp_result c) - | FStar_Syntax_Syntax.Tm_fvar fv -> - let l = FStar_Syntax_Syntax.lid_of_fv fv in - (((FStar_Ident.lid_equals l FStar_Parser_Const.int_lid) || - (FStar_Ident.lid_equals l FStar_Parser_Const.bool_lid)) - || (FStar_Ident.lid_equals l FStar_Parser_Const.string_lid)) - || (FStar_Ident.lid_equals l FStar_Parser_Const.exn_lid) - | uu___1 -> false in - let simplify1 arg = - let uu___ = simp_t (FStar_Pervasives_Native.fst arg) in (uu___, arg) in - let uu___ = - let uu___1 = FStar_Syntax_Subst.compress tm in - uu___1.FStar_Syntax_Syntax.n in - match uu___ with - | FStar_Syntax_Syntax.Tm_app - { - FStar_Syntax_Syntax.hd = - { - FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_uinst - ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; - FStar_Syntax_Syntax.pos = uu___1; - FStar_Syntax_Syntax.vars = uu___2; - FStar_Syntax_Syntax.hash_code = uu___3;_}, - uu___4); - FStar_Syntax_Syntax.pos = uu___5; - FStar_Syntax_Syntax.vars = uu___6; - FStar_Syntax_Syntax.hash_code = uu___7;_}; - FStar_Syntax_Syntax.args = args;_} - -> - let uu___8 = - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.and_lid in - if uu___8 - then - let uu___9 = FStar_Compiler_List.map simplify1 args in - (match uu___9 with - | (FStar_Pervasives_Native.Some (true), uu___10)::(uu___11, - (arg, - uu___12))::[] - -> maybe_auto_squash arg - | (uu___10, (arg, uu___11))::(FStar_Pervasives_Native.Some - (true), uu___12)::[] - -> maybe_auto_squash arg - | (FStar_Pervasives_Native.Some (false), uu___10)::uu___11::[] - -> w FStar_Syntax_Util.t_false - | uu___10::(FStar_Pervasives_Native.Some (false), uu___11)::[] - -> w FStar_Syntax_Util.t_false - | uu___10 -> squashed_head_un_auto_squash_args tm) - else - (let uu___10 = - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.or_lid in - if uu___10 - then - let uu___11 = FStar_Compiler_List.map simplify1 args in - match uu___11 with - | (FStar_Pervasives_Native.Some (true), uu___12)::uu___13::[] - -> w FStar_Syntax_Util.t_true - | uu___12::(FStar_Pervasives_Native.Some (true), uu___13)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false), uu___12)::(uu___13, - (arg, - uu___14))::[] - -> maybe_auto_squash arg - | (uu___12, (arg, uu___13))::(FStar_Pervasives_Native.Some - (false), uu___14)::[] - -> maybe_auto_squash arg - | uu___12 -> squashed_head_un_auto_squash_args tm - else - (let uu___12 = - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.imp_lid in - if uu___12 - then - let uu___13 = FStar_Compiler_List.map simplify1 args in - match uu___13 with - | uu___14::(FStar_Pervasives_Native.Some (true), uu___15)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false), uu___14)::uu___15::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (true), uu___14)::(uu___15, - (arg, - uu___16))::[] - -> maybe_auto_squash arg - | (uu___14, (p, uu___15))::(uu___16, (q, uu___17))::[] -> - let uu___18 = FStar_Syntax_Util.term_eq p q in - (if uu___18 - then w FStar_Syntax_Util.t_true - else squashed_head_un_auto_squash_args tm) - | uu___14 -> squashed_head_un_auto_squash_args tm - else - (let uu___14 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.iff_lid in - if uu___14 - then - let uu___15 = FStar_Compiler_List.map simplify1 args in - match uu___15 with - | (FStar_Pervasives_Native.Some (true), uu___16):: - (FStar_Pervasives_Native.Some (true), uu___17)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false), uu___16):: - (FStar_Pervasives_Native.Some (false), uu___17)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (true), uu___16):: - (FStar_Pervasives_Native.Some (false), uu___17)::[] - -> w FStar_Syntax_Util.t_false - | (FStar_Pervasives_Native.Some (false), uu___16):: - (FStar_Pervasives_Native.Some (true), uu___17)::[] - -> w FStar_Syntax_Util.t_false - | (uu___16, (arg, uu___17))::(FStar_Pervasives_Native.Some - (true), uu___18)::[] - -> maybe_auto_squash arg - | (FStar_Pervasives_Native.Some (true), uu___16):: - (uu___17, (arg, uu___18))::[] -> - maybe_auto_squash arg - | (uu___16, (arg, uu___17))::(FStar_Pervasives_Native.Some - (false), uu___18)::[] - -> - let uu___19 = FStar_Syntax_Util.mk_neg arg in - maybe_auto_squash uu___19 - | (FStar_Pervasives_Native.Some (false), uu___16):: - (uu___17, (arg, uu___18))::[] -> - let uu___19 = FStar_Syntax_Util.mk_neg arg in - maybe_auto_squash uu___19 - | (uu___16, (p, uu___17))::(uu___18, (q, uu___19))::[] - -> - let uu___20 = FStar_Syntax_Util.term_eq p q in - (if uu___20 - then w FStar_Syntax_Util.t_true - else squashed_head_un_auto_squash_args tm) - | uu___16 -> squashed_head_un_auto_squash_args tm - else - (let uu___16 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.not_lid in - if uu___16 - then - let uu___17 = FStar_Compiler_List.map simplify1 args in - match uu___17 with - | (FStar_Pervasives_Native.Some (true), uu___18)::[] - -> w FStar_Syntax_Util.t_false - | (FStar_Pervasives_Native.Some (false), uu___18)::[] - -> w FStar_Syntax_Util.t_true - | uu___18 -> squashed_head_un_auto_squash_args tm - else - (let uu___18 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.forall_lid in - if uu___18 - then - match args with - | (t, uu___19)::[] -> - let uu___20 = - let uu___21 = FStar_Syntax_Subst.compress t in - uu___21.FStar_Syntax_Syntax.n in - (match uu___20 with - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = uu___21::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___22;_} - -> - let uu___23 = simp_t body in - (match uu___23 with - | FStar_Pervasives_Native.Some (true) -> - w FStar_Syntax_Util.t_true - | uu___24 -> tm) - | uu___21 -> tm) - | (ty, FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.aqual_implicit = true; - FStar_Syntax_Syntax.aqual_attributes = - uu___19;_})::(t, uu___20)::[] - -> - let uu___21 = - let uu___22 = FStar_Syntax_Subst.compress t in - uu___22.FStar_Syntax_Syntax.n in - (match uu___21 with - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = uu___22::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___23;_} - -> - let uu___24 = simp_t body in - (match uu___24 with - | FStar_Pervasives_Native.Some (true) -> - w FStar_Syntax_Util.t_true - | FStar_Pervasives_Native.Some (false) - when clearly_inhabited ty -> - w FStar_Syntax_Util.t_false - | uu___25 -> tm) - | uu___22 -> tm) - | uu___19 -> tm - else - (let uu___20 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.exists_lid in - if uu___20 - then - match args with - | (t, uu___21)::[] -> - let uu___22 = - let uu___23 = - FStar_Syntax_Subst.compress t in - uu___23.FStar_Syntax_Syntax.n in - (match uu___22 with - | FStar_Syntax_Syntax.Tm_abs - { - FStar_Syntax_Syntax.bs = uu___23::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___24;_} - -> - let uu___25 = simp_t body in - (match uu___25 with - | FStar_Pervasives_Native.Some - (false) -> - w FStar_Syntax_Util.t_false - | uu___26 -> tm) - | uu___23 -> tm) - | (ty, FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.aqual_implicit = true; - FStar_Syntax_Syntax.aqual_attributes = - uu___21;_})::(t, uu___22)::[] - -> - let uu___23 = - let uu___24 = - FStar_Syntax_Subst.compress t in - uu___24.FStar_Syntax_Syntax.n in - (match uu___23 with - | FStar_Syntax_Syntax.Tm_abs - { - FStar_Syntax_Syntax.bs = uu___24::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___25;_} - -> - let uu___26 = simp_t body in - (match uu___26 with - | FStar_Pervasives_Native.Some - (false) -> - w FStar_Syntax_Util.t_false - | FStar_Pervasives_Native.Some (true) - when clearly_inhabited ty -> - w FStar_Syntax_Util.t_true - | uu___27 -> tm) - | uu___24 -> tm) - | uu___21 -> tm - else - (let uu___22 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.b2t_lid in - if uu___22 - then - match args with - | ({ - FStar_Syntax_Syntax.n = - FStar_Syntax_Syntax.Tm_constant - (FStar_Const.Const_bool (true)); - FStar_Syntax_Syntax.pos = uu___23; - FStar_Syntax_Syntax.vars = uu___24; - FStar_Syntax_Syntax.hash_code = uu___25;_}, - uu___26)::[] -> - w FStar_Syntax_Util.t_true - | ({ - FStar_Syntax_Syntax.n = - FStar_Syntax_Syntax.Tm_constant - (FStar_Const.Const_bool (false)); - FStar_Syntax_Syntax.pos = uu___23; - FStar_Syntax_Syntax.vars = uu___24; - FStar_Syntax_Syntax.hash_code = uu___25;_}, - uu___26)::[] -> - w FStar_Syntax_Util.t_false - | uu___23 -> tm - else - (let uu___24 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.haseq_lid in - if uu___24 - then - let t_has_eq_for_sure t = - let haseq_lids = - [FStar_Parser_Const.int_lid; - FStar_Parser_Const.bool_lid; - FStar_Parser_Const.unit_lid; - FStar_Parser_Const.string_lid] in - let uu___25 = - let uu___26 = - FStar_Syntax_Subst.compress t in - uu___26.FStar_Syntax_Syntax.n in - match uu___25 with - | FStar_Syntax_Syntax.Tm_fvar fv1 when - FStar_Compiler_List.existsb - (fun l -> - FStar_Syntax_Syntax.fv_eq_lid - fv1 l) haseq_lids - -> true - | uu___26 -> false in - (if - (FStar_Compiler_List.length args) = - Prims.int_one - then - let t = - let uu___25 = - FStar_Compiler_List.hd args in - FStar_Pervasives_Native.fst uu___25 in - let uu___25 = t_has_eq_for_sure t in - (if uu___25 - then w FStar_Syntax_Util.t_true - else - (let uu___27 = - let uu___28 = - FStar_Syntax_Subst.compress t in - uu___28.FStar_Syntax_Syntax.n in - match uu___27 with - | FStar_Syntax_Syntax.Tm_refine - uu___28 -> - let t1 = - FStar_Syntax_Util.unrefine t in - let uu___29 = - t_has_eq_for_sure t1 in - if uu___29 - then - w FStar_Syntax_Util.t_true - else - (let haseq_tm = - let uu___31 = - let uu___32 = - FStar_Syntax_Subst.compress - tm in - uu___32.FStar_Syntax_Syntax.n in - match uu___31 with - | FStar_Syntax_Syntax.Tm_app - { - FStar_Syntax_Syntax.hd - = hd; - FStar_Syntax_Syntax.args - = uu___32;_} - -> hd - | uu___32 -> - FStar_Compiler_Effect.failwith - "Impossible! We have already checked that this is a Tm_app" in - let uu___31 = - let uu___32 = - FStar_Syntax_Syntax.as_arg - t1 in - [uu___32] in - FStar_Syntax_Util.mk_app - haseq_tm uu___31) - | uu___28 -> tm)) - else tm) - else - (let uu___26 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.eq2_lid in - if uu___26 - then - match args with - | (_typ, uu___27)::(a1, uu___28):: - (a2, uu___29)::[] -> - let uu___30 = - FStar_Syntax_Util.eq_tm a1 a2 in - (match uu___30 with - | FStar_Syntax_Util.Equal -> - w FStar_Syntax_Util.t_true - | FStar_Syntax_Util.NotEqual -> - w FStar_Syntax_Util.t_false - | uu___31 -> tm) - | uu___27 -> tm - else - (let uu___28 = - FStar_Syntax_Util.is_auto_squash tm in - match uu___28 with - | FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.U_zero, t) - when - FStar_Syntax_Util.is_sub_singleton - t - -> t - | uu___29 -> tm)))))))))) - | FStar_Syntax_Syntax.Tm_app - { - FStar_Syntax_Syntax.hd = - { FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; - FStar_Syntax_Syntax.pos = uu___1; - FStar_Syntax_Syntax.vars = uu___2; - FStar_Syntax_Syntax.hash_code = uu___3;_}; - FStar_Syntax_Syntax.args = args;_} - -> - let uu___4 = - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.and_lid in - if uu___4 - then - let uu___5 = FStar_Compiler_List.map simplify1 args in - (match uu___5 with - | (FStar_Pervasives_Native.Some (true), uu___6)::(uu___7, - (arg, uu___8))::[] - -> maybe_auto_squash arg - | (uu___6, (arg, uu___7))::(FStar_Pervasives_Native.Some (true), - uu___8)::[] - -> maybe_auto_squash arg - | (FStar_Pervasives_Native.Some (false), uu___6)::uu___7::[] -> - w FStar_Syntax_Util.t_false - | uu___6::(FStar_Pervasives_Native.Some (false), uu___7)::[] -> - w FStar_Syntax_Util.t_false - | uu___6 -> squashed_head_un_auto_squash_args tm) - else - (let uu___6 = - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.or_lid in - if uu___6 - then - let uu___7 = FStar_Compiler_List.map simplify1 args in - match uu___7 with - | (FStar_Pervasives_Native.Some (true), uu___8)::uu___9::[] -> - w FStar_Syntax_Util.t_true - | uu___8::(FStar_Pervasives_Native.Some (true), uu___9)::[] -> - w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false), uu___8)::(uu___9, - (arg, - uu___10))::[] - -> maybe_auto_squash arg - | (uu___8, (arg, uu___9))::(FStar_Pervasives_Native.Some - (false), uu___10)::[] - -> maybe_auto_squash arg - | uu___8 -> squashed_head_un_auto_squash_args tm - else - (let uu___8 = - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.imp_lid in - if uu___8 - then - let uu___9 = FStar_Compiler_List.map simplify1 args in - match uu___9 with - | uu___10::(FStar_Pervasives_Native.Some (true), uu___11)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false), uu___10)::uu___11::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (true), uu___10)::(uu___11, - (arg, - uu___12))::[] - -> maybe_auto_squash arg - | (uu___10, (p, uu___11))::(uu___12, (q, uu___13))::[] -> - let uu___14 = FStar_Syntax_Util.term_eq p q in - (if uu___14 - then w FStar_Syntax_Util.t_true - else squashed_head_un_auto_squash_args tm) - | uu___10 -> squashed_head_un_auto_squash_args tm - else - (let uu___10 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.iff_lid in - if uu___10 - then - let uu___11 = FStar_Compiler_List.map simplify1 args in - match uu___11 with - | (FStar_Pervasives_Native.Some (true), uu___12):: - (FStar_Pervasives_Native.Some (true), uu___13)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false), uu___12):: - (FStar_Pervasives_Native.Some (false), uu___13)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (true), uu___12):: - (FStar_Pervasives_Native.Some (false), uu___13)::[] - -> w FStar_Syntax_Util.t_false - | (FStar_Pervasives_Native.Some (false), uu___12):: - (FStar_Pervasives_Native.Some (true), uu___13)::[] - -> w FStar_Syntax_Util.t_false - | (uu___12, (arg, uu___13))::(FStar_Pervasives_Native.Some - (true), uu___14)::[] - -> maybe_auto_squash arg - | (FStar_Pervasives_Native.Some (true), uu___12):: - (uu___13, (arg, uu___14))::[] -> - maybe_auto_squash arg - | (uu___12, (arg, uu___13))::(FStar_Pervasives_Native.Some - (false), uu___14)::[] - -> - let uu___15 = FStar_Syntax_Util.mk_neg arg in - maybe_auto_squash uu___15 - | (FStar_Pervasives_Native.Some (false), uu___12):: - (uu___13, (arg, uu___14))::[] -> - let uu___15 = FStar_Syntax_Util.mk_neg arg in - maybe_auto_squash uu___15 - | (uu___12, (p, uu___13))::(uu___14, (q, uu___15))::[] - -> - let uu___16 = FStar_Syntax_Util.term_eq p q in - (if uu___16 - then w FStar_Syntax_Util.t_true - else squashed_head_un_auto_squash_args tm) - | uu___12 -> squashed_head_un_auto_squash_args tm - else - (let uu___12 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.not_lid in - if uu___12 - then - let uu___13 = FStar_Compiler_List.map simplify1 args in - match uu___13 with - | (FStar_Pervasives_Native.Some (true), uu___14)::[] - -> w FStar_Syntax_Util.t_false - | (FStar_Pervasives_Native.Some (false), uu___14)::[] - -> w FStar_Syntax_Util.t_true - | uu___14 -> squashed_head_un_auto_squash_args tm - else - (let uu___14 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.forall_lid in - if uu___14 - then - match args with - | (t, uu___15)::[] -> - let uu___16 = - let uu___17 = FStar_Syntax_Subst.compress t in - uu___17.FStar_Syntax_Syntax.n in - (match uu___16 with - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = uu___17::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___18;_} - -> - let uu___19 = simp_t body in - (match uu___19 with - | FStar_Pervasives_Native.Some (true) -> - w FStar_Syntax_Util.t_true - | uu___20 -> tm) - | uu___17 -> tm) - | (ty, FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.aqual_implicit = true; - FStar_Syntax_Syntax.aqual_attributes = - uu___15;_})::(t, uu___16)::[] - -> - let uu___17 = - let uu___18 = FStar_Syntax_Subst.compress t in - uu___18.FStar_Syntax_Syntax.n in - (match uu___17 with - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = uu___18::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___19;_} - -> - let uu___20 = simp_t body in - (match uu___20 with - | FStar_Pervasives_Native.Some (true) -> - w FStar_Syntax_Util.t_true - | FStar_Pervasives_Native.Some (false) - when clearly_inhabited ty -> - w FStar_Syntax_Util.t_false - | uu___21 -> tm) - | uu___18 -> tm) - | uu___15 -> tm - else - (let uu___16 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.exists_lid in - if uu___16 - then - match args with - | (t, uu___17)::[] -> - let uu___18 = - let uu___19 = - FStar_Syntax_Subst.compress t in - uu___19.FStar_Syntax_Syntax.n in - (match uu___18 with - | FStar_Syntax_Syntax.Tm_abs - { - FStar_Syntax_Syntax.bs = uu___19::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___20;_} - -> - let uu___21 = simp_t body in - (match uu___21 with - | FStar_Pervasives_Native.Some - (false) -> - w FStar_Syntax_Util.t_false - | uu___22 -> tm) - | uu___19 -> tm) - | (ty, FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.aqual_implicit = true; - FStar_Syntax_Syntax.aqual_attributes = - uu___17;_})::(t, uu___18)::[] - -> - let uu___19 = - let uu___20 = - FStar_Syntax_Subst.compress t in - uu___20.FStar_Syntax_Syntax.n in - (match uu___19 with - | FStar_Syntax_Syntax.Tm_abs - { - FStar_Syntax_Syntax.bs = uu___20::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___21;_} - -> - let uu___22 = simp_t body in - (match uu___22 with - | FStar_Pervasives_Native.Some - (false) -> - w FStar_Syntax_Util.t_false - | FStar_Pervasives_Native.Some (true) - when clearly_inhabited ty -> - w FStar_Syntax_Util.t_true - | uu___23 -> tm) - | uu___20 -> tm) - | uu___17 -> tm - else - (let uu___18 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.b2t_lid in - if uu___18 - then - match args with - | ({ - FStar_Syntax_Syntax.n = - FStar_Syntax_Syntax.Tm_constant - (FStar_Const.Const_bool (true)); - FStar_Syntax_Syntax.pos = uu___19; - FStar_Syntax_Syntax.vars = uu___20; - FStar_Syntax_Syntax.hash_code = uu___21;_}, - uu___22)::[] -> - w FStar_Syntax_Util.t_true - | ({ - FStar_Syntax_Syntax.n = - FStar_Syntax_Syntax.Tm_constant - (FStar_Const.Const_bool (false)); - FStar_Syntax_Syntax.pos = uu___19; - FStar_Syntax_Syntax.vars = uu___20; - FStar_Syntax_Syntax.hash_code = uu___21;_}, - uu___22)::[] -> - w FStar_Syntax_Util.t_false - | uu___19 -> tm - else - (let uu___20 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.haseq_lid in - if uu___20 - then - let t_has_eq_for_sure t = - let haseq_lids = - [FStar_Parser_Const.int_lid; - FStar_Parser_Const.bool_lid; - FStar_Parser_Const.unit_lid; - FStar_Parser_Const.string_lid] in - let uu___21 = - let uu___22 = - FStar_Syntax_Subst.compress t in - uu___22.FStar_Syntax_Syntax.n in - match uu___21 with - | FStar_Syntax_Syntax.Tm_fvar fv1 when - FStar_Compiler_List.existsb - (fun l -> - FStar_Syntax_Syntax.fv_eq_lid - fv1 l) haseq_lids - -> true - | uu___22 -> false in - (if - (FStar_Compiler_List.length args) = - Prims.int_one - then - let t = - let uu___21 = - FStar_Compiler_List.hd args in - FStar_Pervasives_Native.fst uu___21 in - let uu___21 = t_has_eq_for_sure t in - (if uu___21 - then w FStar_Syntax_Util.t_true - else - (let uu___23 = - let uu___24 = - FStar_Syntax_Subst.compress t in - uu___24.FStar_Syntax_Syntax.n in - match uu___23 with - | FStar_Syntax_Syntax.Tm_refine - uu___24 -> - let t1 = - FStar_Syntax_Util.unrefine t in - let uu___25 = - t_has_eq_for_sure t1 in - if uu___25 - then - w FStar_Syntax_Util.t_true - else - (let haseq_tm = - let uu___27 = - let uu___28 = - FStar_Syntax_Subst.compress - tm in - uu___28.FStar_Syntax_Syntax.n in - match uu___27 with - | FStar_Syntax_Syntax.Tm_app - { - FStar_Syntax_Syntax.hd - = hd; - FStar_Syntax_Syntax.args - = uu___28;_} - -> hd - | uu___28 -> - FStar_Compiler_Effect.failwith - "Impossible! We have already checked that this is a Tm_app" in - let uu___27 = - let uu___28 = - FStar_Syntax_Syntax.as_arg - t1 in - [uu___28] in - FStar_Syntax_Util.mk_app - haseq_tm uu___27) - | uu___24 -> tm)) - else tm) - else - (let uu___22 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.eq2_lid in - if uu___22 - then - match args with - | (_typ, uu___23)::(a1, uu___24):: - (a2, uu___25)::[] -> - let uu___26 = - FStar_Syntax_Util.eq_tm a1 a2 in - (match uu___26 with - | FStar_Syntax_Util.Equal -> - w FStar_Syntax_Util.t_true - | FStar_Syntax_Util.NotEqual -> - w FStar_Syntax_Util.t_false - | uu___27 -> tm) - | uu___23 -> tm - else - (let uu___24 = - FStar_Syntax_Util.is_auto_squash tm in - match uu___24 with - | FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.U_zero, t) - when - FStar_Syntax_Util.is_sub_singleton - t - -> t - | uu___25 -> tm)))))))))) - | FStar_Syntax_Syntax.Tm_refine - { FStar_Syntax_Syntax.b = bv; FStar_Syntax_Syntax.phi = t;_} -> - let uu___1 = simp_t t in - (match uu___1 with - | FStar_Pervasives_Native.Some (true) -> - bv.FStar_Syntax_Syntax.sort - | FStar_Pervasives_Native.Some (false) -> tm - | FStar_Pervasives_Native.None -> tm) - | FStar_Syntax_Syntax.Tm_match uu___1 -> - let uu___2 = is_const_match tm in - (match uu___2 with - | FStar_Pervasives_Native.Some (true) -> - w FStar_Syntax_Util.t_true - | FStar_Pervasives_Native.Some (false) -> - w FStar_Syntax_Util.t_false - | FStar_Pervasives_Native.None -> tm) - | uu___1 -> tm let (check_positivity_qual : Prims.bool -> FStar_Syntax_Syntax.positivity_qualifier FStar_Pervasives_Native.option diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml index a33bc00b5aa..9ef0b8f3ed1 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml @@ -3604,8 +3604,9 @@ and (check_relation_comp : match uu___ with | (FStar_Pervasives_Native.None, uu___1) -> let uu___2 = - let uu___3 = FStar_Syntax_Util.eq_comp c0 c1 in - uu___3 = FStar_Syntax_Util.Equal in + let uu___3 = + FStar_TypeChecker_TermEqAndSimplify.eq_comp g.tcenv c0 c1 in + uu___3 = FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___2 then (fun uu___3 -> Success ((), FStar_Pervasives_Native.None)) else @@ -3667,8 +3668,9 @@ and (check_relation_comp : fail uu___10)))) | (uu___1, FStar_Pervasives_Native.None) -> let uu___2 = - let uu___3 = FStar_Syntax_Util.eq_comp c0 c1 in - uu___3 = FStar_Syntax_Util.Equal in + let uu___3 = + FStar_TypeChecker_TermEqAndSimplify.eq_comp g.tcenv c0 c1 in + uu___3 = FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___2 then (fun uu___3 -> Success ((), FStar_Pervasives_Native.None)) else diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml index 26392457f1f..b69d166c782 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml @@ -3674,7 +3674,7 @@ and (trans_F_ : ((let uu___10 = let uu___11 = FStar_Syntax_Util.eq_aqual q q' in - uu___11 <> FStar_Syntax_Util.Equal in + Prims.op_Negation uu___11 in if uu___10 then let uu___11 = diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml index 7b0d9d3fa16..e00320e9cef 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml @@ -54,7 +54,7 @@ let (uu___is_Imp : goal_type -> Prims.bool) = let (__proj__Imp__item___0 : goal_type -> FStar_Syntax_Syntax.ctx_uvar) = fun projectee -> match projectee with | Imp _0 -> _0 let (find_user_tac_for_uvar : - FStar_TypeChecker_Env.env -> + FStar_TypeChecker_Env.env_t -> FStar_Syntax_Syntax.ctx_uvar -> FStar_Syntax_Syntax.sigelt FStar_Pervasives_Native.option) = @@ -120,7 +120,8 @@ let (find_user_tac_for_uvar : let candidates = FStar_Compiler_List.filter (fun hook -> - FStar_Compiler_Util.for_some (FStar_Syntax_Util.attr_eq a) + FStar_Compiler_Util.for_some + (FStar_TypeChecker_TermEqAndSimplify.eq_tm_bool env a) hook.FStar_Syntax_Syntax.sigattrs) hooks in let candidates1 = FStar_Compiler_Util.remove_dups @@ -156,7 +157,9 @@ let (find_user_tac_for_uvar : when (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.override_resolve_implicits_handler_lid) - && (FStar_Syntax_Util.attr_eq a a') + && + (FStar_TypeChecker_TermEqAndSimplify.eq_tm_bool + env a a') -> let uu___5 = attr_list_elements overrides in (match uu___5 with @@ -174,7 +177,9 @@ let (find_user_tac_for_uvar : (a', uu___2)::(overrides, uu___3)::[]) when (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.override_resolve_implicits_handler_lid) - && (FStar_Syntax_Util.attr_eq a a') + && + (FStar_TypeChecker_TermEqAndSimplify.eq_tm_bool + env a a') -> let uu___4 = attr_list_elements overrides in (match uu___4 with diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_NBE.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_NBE.ml index 809a89458e4..770d24d7301 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_NBE.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_NBE.ml @@ -2333,7 +2333,8 @@ and (translate_monadic : let maybe_range_arg = let uu___2 = FStar_Compiler_Util.for_some - (FStar_Syntax_Util.attr_eq + (FStar_TypeChecker_TermEqAndSimplify.eq_tm_bool + (cfg.core_cfg).FStar_TypeChecker_Cfg.tcenv FStar_Syntax_Util.dm4f_bind_range_attr) ed.FStar_Syntax_Syntax.eff_attrs in if uu___2 @@ -2889,9 +2890,9 @@ and (readback : if ((cfg.core_cfg).FStar_TypeChecker_Cfg.steps).FStar_TypeChecker_Cfg.simplify then - FStar_TypeChecker_Common.simplify + FStar_TypeChecker_TermEqAndSimplify.simplify ((cfg.core_cfg).FStar_TypeChecker_Cfg.debug).FStar_TypeChecker_Cfg.wpe - refinement + (cfg.core_cfg).FStar_TypeChecker_Cfg.tcenv refinement else refinement in with_range uu___2) | FStar_TypeChecker_NBETerm.Reflect t -> @@ -2958,9 +2959,9 @@ and (readback : if ((cfg.core_cfg).FStar_TypeChecker_Cfg.steps).FStar_TypeChecker_Cfg.simplify then - FStar_TypeChecker_Common.simplify + FStar_TypeChecker_TermEqAndSimplify.simplify ((cfg.core_cfg).FStar_TypeChecker_Cfg.debug).FStar_TypeChecker_Cfg.wpe - app + (cfg.core_cfg).FStar_TypeChecker_Cfg.tcenv app else app in with_range uu___1 | FStar_TypeChecker_NBETerm.Accu @@ -2977,9 +2978,9 @@ and (readback : if ((cfg.core_cfg).FStar_TypeChecker_Cfg.steps).FStar_TypeChecker_Cfg.simplify then - FStar_TypeChecker_Common.simplify + FStar_TypeChecker_TermEqAndSimplify.simplify ((cfg.core_cfg).FStar_TypeChecker_Cfg.debug).FStar_TypeChecker_Cfg.wpe - app + (cfg.core_cfg).FStar_TypeChecker_Cfg.tcenv app else app in with_range uu___1 | FStar_TypeChecker_NBETerm.Accu @@ -3005,9 +3006,9 @@ and (readback : if ((cfg.core_cfg).FStar_TypeChecker_Cfg.steps).FStar_TypeChecker_Cfg.simplify then - FStar_TypeChecker_Common.simplify + FStar_TypeChecker_TermEqAndSimplify.simplify ((cfg.core_cfg).FStar_TypeChecker_Cfg.debug).FStar_TypeChecker_Cfg.wpe - app + (cfg.core_cfg).FStar_TypeChecker_Cfg.tcenv app else app in with_range uu___1 | FStar_TypeChecker_NBETerm.Accu diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml index 1ab8f46c7b0..8ce4cccdcc6 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml @@ -418,124 +418,153 @@ let (mkAccuMatch : = fun s -> fun ret -> fun bs -> fun rc -> mk_t (Accu ((Match (s, ret, bs, rc)), [])) -let (equal_if : Prims.bool -> FStar_Syntax_Util.eq_result) = +let (equal_if : Prims.bool -> FStar_TypeChecker_TermEqAndSimplify.eq_result) + = fun uu___ -> - if uu___ then FStar_Syntax_Util.Equal else FStar_Syntax_Util.Unknown -let (equal_iff : Prims.bool -> FStar_Syntax_Util.eq_result) = + if uu___ + then FStar_TypeChecker_TermEqAndSimplify.Equal + else FStar_TypeChecker_TermEqAndSimplify.Unknown +let (equal_iff : Prims.bool -> FStar_TypeChecker_TermEqAndSimplify.eq_result) + = fun uu___ -> - if uu___ then FStar_Syntax_Util.Equal else FStar_Syntax_Util.NotEqual + if uu___ + then FStar_TypeChecker_TermEqAndSimplify.Equal + else FStar_TypeChecker_TermEqAndSimplify.NotEqual let (eq_inj : - FStar_Syntax_Util.eq_result -> - FStar_Syntax_Util.eq_result -> FStar_Syntax_Util.eq_result) + FStar_TypeChecker_TermEqAndSimplify.eq_result -> + FStar_TypeChecker_TermEqAndSimplify.eq_result -> + FStar_TypeChecker_TermEqAndSimplify.eq_result) = fun r1 -> fun r2 -> match (r1, r2) with - | (FStar_Syntax_Util.Equal, FStar_Syntax_Util.Equal) -> - FStar_Syntax_Util.Equal - | (FStar_Syntax_Util.NotEqual, uu___) -> FStar_Syntax_Util.NotEqual - | (uu___, FStar_Syntax_Util.NotEqual) -> FStar_Syntax_Util.NotEqual - | (FStar_Syntax_Util.Unknown, uu___) -> FStar_Syntax_Util.Unknown - | (uu___, FStar_Syntax_Util.Unknown) -> FStar_Syntax_Util.Unknown + | (FStar_TypeChecker_TermEqAndSimplify.Equal, + FStar_TypeChecker_TermEqAndSimplify.Equal) -> + FStar_TypeChecker_TermEqAndSimplify.Equal + | (FStar_TypeChecker_TermEqAndSimplify.NotEqual, uu___) -> + FStar_TypeChecker_TermEqAndSimplify.NotEqual + | (uu___, FStar_TypeChecker_TermEqAndSimplify.NotEqual) -> + FStar_TypeChecker_TermEqAndSimplify.NotEqual + | (FStar_TypeChecker_TermEqAndSimplify.Unknown, uu___) -> + FStar_TypeChecker_TermEqAndSimplify.Unknown + | (uu___, FStar_TypeChecker_TermEqAndSimplify.Unknown) -> + FStar_TypeChecker_TermEqAndSimplify.Unknown let (eq_and : - FStar_Syntax_Util.eq_result -> - (unit -> FStar_Syntax_Util.eq_result) -> FStar_Syntax_Util.eq_result) + FStar_TypeChecker_TermEqAndSimplify.eq_result -> + (unit -> FStar_TypeChecker_TermEqAndSimplify.eq_result) -> + FStar_TypeChecker_TermEqAndSimplify.eq_result) = fun f -> fun g -> match f with - | FStar_Syntax_Util.Equal -> g () - | uu___ -> FStar_Syntax_Util.Unknown -let (eq_constant : constant -> constant -> FStar_Syntax_Util.eq_result) = + | FStar_TypeChecker_TermEqAndSimplify.Equal -> g () + | uu___ -> FStar_TypeChecker_TermEqAndSimplify.Unknown +let (eq_constant : + constant -> constant -> FStar_TypeChecker_TermEqAndSimplify.eq_result) = fun c1 -> fun c2 -> match (c1, c2) with - | (Unit, Unit) -> FStar_Syntax_Util.Equal + | (Unit, Unit) -> FStar_TypeChecker_TermEqAndSimplify.Equal | (Bool b1, Bool b2) -> equal_iff (b1 = b2) | (Int i1, Int i2) -> equal_iff (i1 = i2) | (String (s1, uu___), String (s2, uu___1)) -> equal_iff (s1 = s2) | (Char c11, Char c21) -> equal_iff (c11 = c21) - | (Range r1, Range r2) -> FStar_Syntax_Util.Unknown - | (uu___, uu___1) -> FStar_Syntax_Util.NotEqual -let rec (eq_t : t -> t -> FStar_Syntax_Util.eq_result) = - fun t1 -> - fun t2 -> - match ((t1.nbe_t), (t2.nbe_t)) with - | (Lam uu___, Lam uu___1) -> FStar_Syntax_Util.Unknown - | (Accu (a1, as1), Accu (a2, as2)) -> - let uu___ = eq_atom a1 a2 in - eq_and uu___ (fun uu___1 -> eq_args as1 as2) - | (Construct (v1, us1, args1), Construct (v2, us2, args2)) -> - let uu___ = FStar_Syntax_Syntax.fv_eq v1 v2 in - if uu___ - then - (if - (FStar_Compiler_List.length args1) <> - (FStar_Compiler_List.length args2) - then - FStar_Compiler_Effect.failwith - "eq_t, different number of args on Construct" - else (); - (let uu___2 = FStar_Compiler_List.zip args1 args2 in - FStar_Compiler_List.fold_left - (fun acc -> - fun uu___3 -> - match uu___3 with - | ((a1, uu___4), (a2, uu___5)) -> - let uu___6 = eq_t a1 a2 in eq_inj acc uu___6) - FStar_Syntax_Util.Equal uu___2)) - else FStar_Syntax_Util.NotEqual - | (FV (v1, us1, args1), FV (v2, us2, args2)) -> - let uu___ = FStar_Syntax_Syntax.fv_eq v1 v2 in - if uu___ - then - let uu___1 = - let uu___2 = FStar_Syntax_Util.eq_univs_list us1 us2 in - equal_iff uu___2 in - eq_and uu___1 (fun uu___2 -> eq_args args1 args2) - else FStar_Syntax_Util.Unknown - | (Constant c1, Constant c2) -> eq_constant c1 c2 - | (Type_t u1, Type_t u2) -> - let uu___ = FStar_Syntax_Util.eq_univs u1 u2 in equal_iff uu___ - | (Univ u1, Univ u2) -> - let uu___ = FStar_Syntax_Util.eq_univs u1 u2 in equal_iff uu___ - | (Refinement (r1, t11), Refinement (r2, t21)) -> - let x = - FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None - FStar_Syntax_Syntax.t_unit in - let uu___ = - let uu___1 = - let uu___2 = t11 () in FStar_Pervasives_Native.fst uu___2 in - let uu___2 = - let uu___3 = t21 () in FStar_Pervasives_Native.fst uu___3 in - eq_t uu___1 uu___2 in - eq_and uu___ - (fun uu___1 -> - let uu___2 = let uu___3 = mkAccuVar x in r1 uu___3 in - let uu___3 = let uu___4 = mkAccuVar x in r2 uu___4 in - eq_t uu___2 uu___3) - | (Unknown, Unknown) -> FStar_Syntax_Util.Equal - | (uu___, uu___1) -> FStar_Syntax_Util.Unknown -and (eq_atom : atom -> atom -> FStar_Syntax_Util.eq_result) = + | (Range r1, Range r2) -> FStar_TypeChecker_TermEqAndSimplify.Unknown + | (uu___, uu___1) -> FStar_TypeChecker_TermEqAndSimplify.NotEqual +let rec (eq_t : + FStar_TypeChecker_Env.env_t -> + t -> t -> FStar_TypeChecker_TermEqAndSimplify.eq_result) + = + fun env -> + fun t1 -> + fun t2 -> + match ((t1.nbe_t), (t2.nbe_t)) with + | (Lam uu___, Lam uu___1) -> + FStar_TypeChecker_TermEqAndSimplify.Unknown + | (Accu (a1, as1), Accu (a2, as2)) -> + let uu___ = eq_atom a1 a2 in + eq_and uu___ (fun uu___1 -> eq_args env as1 as2) + | (Construct (v1, us1, args1), Construct (v2, us2, args2)) -> + let uu___ = FStar_Syntax_Syntax.fv_eq v1 v2 in + if uu___ + then + (if + (FStar_Compiler_List.length args1) <> + (FStar_Compiler_List.length args2) + then + FStar_Compiler_Effect.failwith + "eq_t, different number of args on Construct" + else (); + (let uu___2 = FStar_Compiler_List.zip args1 args2 in + FStar_Compiler_List.fold_left + (fun acc -> + fun uu___3 -> + match uu___3 with + | ((a1, uu___4), (a2, uu___5)) -> + let uu___6 = eq_t env a1 a2 in eq_inj acc uu___6) + FStar_TypeChecker_TermEqAndSimplify.Equal uu___2)) + else FStar_TypeChecker_TermEqAndSimplify.NotEqual + | (FV (v1, us1, args1), FV (v2, us2, args2)) -> + let uu___ = FStar_Syntax_Syntax.fv_eq v1 v2 in + if uu___ + then + let uu___1 = + let uu___2 = FStar_Syntax_Util.eq_univs_list us1 us2 in + equal_iff uu___2 in + eq_and uu___1 (fun uu___2 -> eq_args env args1 args2) + else FStar_TypeChecker_TermEqAndSimplify.Unknown + | (Constant c1, Constant c2) -> eq_constant c1 c2 + | (Type_t u1, Type_t u2) -> + let uu___ = FStar_Syntax_Util.eq_univs u1 u2 in equal_iff uu___ + | (Univ u1, Univ u2) -> + let uu___ = FStar_Syntax_Util.eq_univs u1 u2 in equal_iff uu___ + | (Refinement (r1, t11), Refinement (r2, t21)) -> + let x = + FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None + FStar_Syntax_Syntax.t_unit in + let uu___ = + let uu___1 = + let uu___2 = t11 () in FStar_Pervasives_Native.fst uu___2 in + let uu___2 = + let uu___3 = t21 () in FStar_Pervasives_Native.fst uu___3 in + eq_t env uu___1 uu___2 in + eq_and uu___ + (fun uu___1 -> + let uu___2 = let uu___3 = mkAccuVar x in r1 uu___3 in + let uu___3 = let uu___4 = mkAccuVar x in r2 uu___4 in + eq_t env uu___2 uu___3) + | (Unknown, Unknown) -> FStar_TypeChecker_TermEqAndSimplify.Equal + | (uu___, uu___1) -> FStar_TypeChecker_TermEqAndSimplify.Unknown +and (eq_atom : atom -> atom -> FStar_TypeChecker_TermEqAndSimplify.eq_result) + = fun a1 -> fun a2 -> match (a1, a2) with | (Var bv1, Var bv2) -> let uu___ = FStar_Syntax_Syntax.bv_eq bv1 bv2 in equal_if uu___ - | (uu___, uu___1) -> FStar_Syntax_Util.Unknown -and (eq_arg : arg -> arg -> FStar_Syntax_Util.eq_result) = - fun a1 -> - fun a2 -> - eq_t (FStar_Pervasives_Native.fst a1) (FStar_Pervasives_Native.fst a2) -and (eq_args : args -> args -> FStar_Syntax_Util.eq_result) = - fun as1 -> - fun as2 -> - match (as1, as2) with - | ([], []) -> FStar_Syntax_Util.Equal - | (x::xs, y::ys) -> - let uu___ = eq_arg x y in - eq_and uu___ (fun uu___1 -> eq_args xs ys) - | (uu___, uu___1) -> FStar_Syntax_Util.Unknown + | (uu___, uu___1) -> FStar_TypeChecker_TermEqAndSimplify.Unknown +and (eq_arg : + FStar_TypeChecker_Env.env_t -> + arg -> arg -> FStar_TypeChecker_TermEqAndSimplify.eq_result) + = + fun env -> + fun a1 -> + fun a2 -> + eq_t env (FStar_Pervasives_Native.fst a1) + (FStar_Pervasives_Native.fst a2) +and (eq_args : + FStar_TypeChecker_Env.env_t -> + args -> args -> FStar_TypeChecker_TermEqAndSimplify.eq_result) + = + fun env -> + fun as1 -> + fun as2 -> + match (as1, as2) with + | ([], []) -> FStar_TypeChecker_TermEqAndSimplify.Equal + | (x::xs, y::ys) -> + let uu___ = eq_arg env x y in + eq_and uu___ (fun uu___1 -> eq_args env xs ys) + | (uu___, uu___1) -> FStar_TypeChecker_TermEqAndSimplify.Unknown let (constant_to_string : constant -> Prims.string) = fun c -> match c with diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml index 04bc95afc05..fbe5fb64f0a 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml @@ -1582,7 +1582,10 @@ let (reduce_equality : fun norm_cb -> fun cfg -> fun tm -> - reduce_primops norm_cb + let uu___ = + let uu___1 = + FStar_TypeChecker_Cfg.equality_ops + cfg.FStar_TypeChecker_Cfg.tcenv in { FStar_TypeChecker_Cfg.steps = { @@ -1652,8 +1655,7 @@ let (reduce_equality : FStar_TypeChecker_Cfg.debug = (cfg.FStar_TypeChecker_Cfg.debug); FStar_TypeChecker_Cfg.delta_level = (cfg.FStar_TypeChecker_Cfg.delta_level); - FStar_TypeChecker_Cfg.primitive_steps = - FStar_TypeChecker_Cfg.equality_ops; + FStar_TypeChecker_Cfg.primitive_steps = uu___1; FStar_TypeChecker_Cfg.strong = (cfg.FStar_TypeChecker_Cfg.strong); FStar_TypeChecker_Cfg.memoize_lazy = (cfg.FStar_TypeChecker_Cfg.memoize_lazy); @@ -1663,7 +1665,8 @@ let (reduce_equality : (cfg.FStar_TypeChecker_Cfg.reifying); FStar_TypeChecker_Cfg.compat_memo_ignore_cfg = (cfg.FStar_TypeChecker_Cfg.compat_memo_ignore_cfg) - } tm + } in + reduce_primops norm_cb uu___ tm type norm_request_t = | Norm_request_none | Norm_request_ready @@ -4972,7 +4975,8 @@ and (do_reify_monadic : (let maybe_range_arg = let uu___12 = FStar_Compiler_Util.for_some - (FStar_Syntax_Util.attr_eq + (FStar_TypeChecker_TermEqAndSimplify.eq_tm_bool + cfg.FStar_TypeChecker_Cfg.tcenv FStar_Syntax_Util.dm4f_bind_range_attr) ed.FStar_Syntax_Syntax.eff_attrs in if uu___12 @@ -6420,10 +6424,12 @@ and (maybe_simplify_aux : -> (t, false) | uu___32 -> let uu___33 = - norm_cb cfg in - reduce_equality - uu___33 cfg - env1 tm1)))))))))) + let uu___34 = + norm_cb cfg in + reduce_equality + uu___34 cfg + env1 in + uu___33 tm1)))))))))) | FStar_Syntax_Syntax.Tm_app { FStar_Syntax_Syntax.hd = @@ -6965,10 +6971,12 @@ and (maybe_simplify_aux : -> (t, false) | uu___28 -> let uu___29 = - norm_cb cfg in - reduce_equality - uu___29 cfg - env1 tm1)))))))))) + let uu___30 = + norm_cb cfg in + reduce_equality + uu___30 cfg + env1 in + uu___29 tm1)))))))))) | FStar_Syntax_Syntax.Tm_refine { FStar_Syntax_Syntax.b = bv; FStar_Syntax_Syntax.phi = t;_} diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize_Unfolding.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize_Unfolding.ml index 76069b83a47..b18144f3b1b 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize_Unfolding.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize_Unfolding.ml @@ -694,7 +694,8 @@ let (should_unfold : (cfg.FStar_TypeChecker_Cfg.steps).FStar_TypeChecker_Cfg.unfold_tac && (FStar_Compiler_Util.for_some - (FStar_Syntax_Util.attr_eq + (FStar_TypeChecker_TermEqAndSimplify.eq_tm_bool + cfg.FStar_TypeChecker_Cfg.tcenv FStar_Syntax_Util.tac_opaque_attr) attrs) -> (FStar_TypeChecker_Cfg.log_unfolding cfg diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops.ml index cc07f707b7a..6bc474617d9 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops.ml @@ -1146,9 +1146,12 @@ let (built_in_primitive_steps_list : FStar_TypeChecker_Primops_Docs.ops (FStar_Compiler_List.op_At FStar_TypeChecker_Primops_MachineInts.ops - (FStar_Compiler_List.op_At - FStar_TypeChecker_Primops_Eq.dec_eq_ops - FStar_TypeChecker_Primops_Errors_Msg.ops)))))))) + FStar_TypeChecker_Primops_Errors_Msg.ops))))))) let (equality_ops_list : - FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = - FStar_TypeChecker_Primops_Eq.prop_eq_ops \ No newline at end of file + FStar_TypeChecker_Env.env_t -> + FStar_TypeChecker_Primops_Base.primitive_step Prims.list) + = fun env -> FStar_TypeChecker_Primops_Eq.prop_eq_ops env +let (env_dependent_ops : + FStar_TypeChecker_Env.env_t -> + FStar_TypeChecker_Primops_Base.primitive_step Prims.list) + = fun env -> FStar_TypeChecker_Primops_Eq.dec_eq_ops env \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Eq.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Eq.ml index 833b8d1e78e..257be3a2c80 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Eq.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Eq.ml @@ -1,38 +1,46 @@ open Prims let (s_eq : - FStar_Syntax_Embeddings.abstract_term -> + FStar_TypeChecker_Env.env_t -> FStar_Syntax_Embeddings.abstract_term -> FStar_Syntax_Embeddings.abstract_term -> - Prims.bool FStar_Pervasives_Native.option) + FStar_Syntax_Embeddings.abstract_term -> + Prims.bool FStar_Pervasives_Native.option) = - fun _typ -> - fun x -> - fun y -> - let uu___ = - FStar_Syntax_Util.eq_tm - (FStar_Syntax_Embeddings.__proj__Abstract__item__t x) - (FStar_Syntax_Embeddings.__proj__Abstract__item__t y) in - match uu___ with - | FStar_Syntax_Util.Equal -> FStar_Pervasives_Native.Some true - | FStar_Syntax_Util.NotEqual -> FStar_Pervasives_Native.Some false - | uu___1 -> FStar_Pervasives_Native.None + fun env -> + fun _typ -> + fun x -> + fun y -> + let uu___ = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env + (FStar_Syntax_Embeddings.__proj__Abstract__item__t x) + (FStar_Syntax_Embeddings.__proj__Abstract__item__t y) in + match uu___ with + | FStar_TypeChecker_TermEqAndSimplify.Equal -> + FStar_Pervasives_Native.Some true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> + FStar_Pervasives_Native.Some false + | uu___1 -> FStar_Pervasives_Native.None let (nbe_eq : - FStar_TypeChecker_NBETerm.abstract_nbe_term -> + FStar_TypeChecker_Env.env_t -> FStar_TypeChecker_NBETerm.abstract_nbe_term -> FStar_TypeChecker_NBETerm.abstract_nbe_term -> - Prims.bool FStar_Pervasives_Native.option) + FStar_TypeChecker_NBETerm.abstract_nbe_term -> + Prims.bool FStar_Pervasives_Native.option) = - fun _typ -> - fun x -> - fun y -> - let uu___ = - FStar_TypeChecker_NBETerm.eq_t - (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t x) - (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t y) in - match uu___ with - | FStar_Syntax_Util.Equal -> FStar_Pervasives_Native.Some true - | FStar_Syntax_Util.NotEqual -> FStar_Pervasives_Native.Some false - | uu___1 -> FStar_Pervasives_Native.None + fun env -> + fun _typ -> + fun x -> + fun y -> + let uu___ = + FStar_TypeChecker_NBETerm.eq_t env + (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t x) + (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t y) in + match uu___ with + | FStar_TypeChecker_TermEqAndSimplify.Equal -> + FStar_Pervasives_Native.Some true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> + FStar_Pervasives_Native.Some false + | uu___1 -> FStar_Pervasives_Native.None let push3 : 'uuuuu 'uuuuu1 'uuuuu2 'uuuuu3 'uuuuu4 . ('uuuuu -> 'uuuuu1) -> @@ -55,142 +63,76 @@ let negopt3 : (Obj.magic (FStar_Class_Monad.fmap FStar_Class_Monad.monad_option () () (fun uu___1 -> (Obj.magic Prims.op_Negation) uu___1))) uu___1) -let (dec_eq_ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = - let uu___ = - FStar_TypeChecker_Primops_Base.mk3' Prims.int_zero - FStar_Parser_Const.op_Eq FStar_Syntax_Embeddings.e_abstract_term - FStar_TypeChecker_NBETerm.e_abstract_nbe_term - FStar_Syntax_Embeddings.e_abstract_term - FStar_TypeChecker_NBETerm.e_abstract_nbe_term - FStar_Syntax_Embeddings.e_abstract_term - FStar_TypeChecker_NBETerm.e_abstract_nbe_term - FStar_Syntax_Embeddings.e_bool FStar_TypeChecker_NBETerm.e_bool s_eq - nbe_eq in - let uu___1 = - let uu___2 = +let (dec_eq_ops : + FStar_TypeChecker_Env.env_t -> + FStar_TypeChecker_Primops_Base.primitive_step Prims.list) + = + fun env -> + let uu___ = FStar_TypeChecker_Primops_Base.mk3' Prims.int_zero - FStar_Parser_Const.op_notEq FStar_Syntax_Embeddings.e_abstract_term + FStar_Parser_Const.op_Eq FStar_Syntax_Embeddings.e_abstract_term FStar_TypeChecker_NBETerm.e_abstract_nbe_term FStar_Syntax_Embeddings.e_abstract_term FStar_TypeChecker_NBETerm.e_abstract_nbe_term FStar_Syntax_Embeddings.e_abstract_term FStar_TypeChecker_NBETerm.e_abstract_nbe_term FStar_Syntax_Embeddings.e_bool FStar_TypeChecker_NBETerm.e_bool - ((negopt3 ()) s_eq) ((negopt3 ()) nbe_eq) in - [uu___2] in - uu___ :: uu___1 + (s_eq env) (nbe_eq env) in + let uu___1 = + let uu___2 = + FStar_TypeChecker_Primops_Base.mk3' Prims.int_zero + FStar_Parser_Const.op_notEq FStar_Syntax_Embeddings.e_abstract_term + FStar_TypeChecker_NBETerm.e_abstract_nbe_term + FStar_Syntax_Embeddings.e_abstract_term + FStar_TypeChecker_NBETerm.e_abstract_nbe_term + FStar_Syntax_Embeddings.e_abstract_term + FStar_TypeChecker_NBETerm.e_abstract_nbe_term + FStar_Syntax_Embeddings.e_bool FStar_TypeChecker_NBETerm.e_bool + ((negopt3 ()) (s_eq env)) ((negopt3 ()) (nbe_eq env)) in + [uu___2] in + uu___ :: uu___1 let (s_eq2 : - FStar_Syntax_Embeddings.abstract_term -> - FStar_Syntax_Embeddings.abstract_term -> - FStar_Syntax_Embeddings.abstract_term -> - FStar_Syntax_Embeddings.abstract_term FStar_Pervasives_Native.option) - = - fun _typ -> - fun x -> - fun y -> - let uu___ = - FStar_Syntax_Util.eq_tm - (FStar_Syntax_Embeddings.__proj__Abstract__item__t x) - (FStar_Syntax_Embeddings.__proj__Abstract__item__t y) in - match uu___ with - | FStar_Syntax_Util.Equal -> - FStar_Pervasives_Native.Some - (FStar_Syntax_Embeddings.Abstract FStar_Syntax_Util.t_true) - | FStar_Syntax_Util.NotEqual -> - FStar_Pervasives_Native.Some - (FStar_Syntax_Embeddings.Abstract FStar_Syntax_Util.t_false) - | uu___1 -> FStar_Pervasives_Native.None -let (nbe_eq2 : - FStar_TypeChecker_NBETerm.abstract_nbe_term -> - FStar_TypeChecker_NBETerm.abstract_nbe_term -> - FStar_TypeChecker_NBETerm.abstract_nbe_term -> - FStar_TypeChecker_NBETerm.abstract_nbe_term - FStar_Pervasives_Native.option) - = - fun _typ -> - fun x -> - fun y -> - let uu___ = - FStar_TypeChecker_NBETerm.eq_t - (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t x) - (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t y) in - match uu___ with - | FStar_Syntax_Util.Equal -> - let uu___1 = - let uu___2 = - let uu___3 = - FStar_Syntax_Syntax.lid_as_fv FStar_Parser_Const.true_lid - FStar_Pervasives_Native.None in - FStar_TypeChecker_NBETerm.mkFV uu___3 [] [] in - FStar_TypeChecker_NBETerm.AbstractNBE uu___2 in - FStar_Pervasives_Native.Some uu___1 - | FStar_Syntax_Util.NotEqual -> - let uu___1 = - let uu___2 = - let uu___3 = - FStar_Syntax_Syntax.lid_as_fv FStar_Parser_Const.false_lid - FStar_Pervasives_Native.None in - FStar_TypeChecker_NBETerm.mkFV uu___3 [] [] in - FStar_TypeChecker_NBETerm.AbstractNBE uu___2 in - FStar_Pervasives_Native.Some uu___1 - | FStar_Syntax_Util.Unknown -> FStar_Pervasives_Native.None -let (s_eq3 : - FStar_Syntax_Embeddings.abstract_term -> + FStar_TypeChecker_Env.env_t -> FStar_Syntax_Embeddings.abstract_term -> FStar_Syntax_Embeddings.abstract_term -> FStar_Syntax_Embeddings.abstract_term -> FStar_Syntax_Embeddings.abstract_term FStar_Pervasives_Native.option) = - fun typ1 -> - fun typ2 -> + fun env -> + fun _typ -> fun x -> fun y -> let uu___ = - let uu___1 = - FStar_Syntax_Util.eq_tm - (FStar_Syntax_Embeddings.__proj__Abstract__item__t typ1) - (FStar_Syntax_Embeddings.__proj__Abstract__item__t typ2) in - let uu___2 = - FStar_Syntax_Util.eq_tm - (FStar_Syntax_Embeddings.__proj__Abstract__item__t x) - (FStar_Syntax_Embeddings.__proj__Abstract__item__t y) in - (uu___1, uu___2) in + FStar_TypeChecker_TermEqAndSimplify.eq_tm env + (FStar_Syntax_Embeddings.__proj__Abstract__item__t x) + (FStar_Syntax_Embeddings.__proj__Abstract__item__t y) in match uu___ with - | (FStar_Syntax_Util.Equal, FStar_Syntax_Util.Equal) -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> FStar_Pervasives_Native.Some (FStar_Syntax_Embeddings.Abstract FStar_Syntax_Util.t_true) - | (FStar_Syntax_Util.NotEqual, uu___1) -> - FStar_Pervasives_Native.Some - (FStar_Syntax_Embeddings.Abstract FStar_Syntax_Util.t_false) - | (uu___1, FStar_Syntax_Util.NotEqual) -> + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> FStar_Pervasives_Native.Some (FStar_Syntax_Embeddings.Abstract FStar_Syntax_Util.t_false) | uu___1 -> FStar_Pervasives_Native.None -let (nbe_eq3 : - FStar_TypeChecker_NBETerm.abstract_nbe_term -> +let (nbe_eq2 : + FStar_TypeChecker_Env.env_t -> FStar_TypeChecker_NBETerm.abstract_nbe_term -> FStar_TypeChecker_NBETerm.abstract_nbe_term -> FStar_TypeChecker_NBETerm.abstract_nbe_term -> FStar_TypeChecker_NBETerm.abstract_nbe_term FStar_Pervasives_Native.option) = - fun typ1 -> - fun typ2 -> + fun env -> + fun _typ -> fun x -> fun y -> let uu___ = - let uu___1 = - FStar_TypeChecker_NBETerm.eq_t - (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t typ1) - (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t typ2) in - let uu___2 = - FStar_TypeChecker_NBETerm.eq_t - (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t x) - (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t y) in - (uu___1, uu___2) in + FStar_TypeChecker_NBETerm.eq_t env + (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t x) + (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t y) in match uu___ with - | (FStar_Syntax_Util.Equal, FStar_Syntax_Util.Equal) -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> let uu___1 = let uu___2 = let uu___3 = @@ -199,51 +141,142 @@ let (nbe_eq3 : FStar_TypeChecker_NBETerm.mkFV uu___3 [] [] in FStar_TypeChecker_NBETerm.AbstractNBE uu___2 in FStar_Pervasives_Native.Some uu___1 - | (FStar_Syntax_Util.NotEqual, uu___1) -> - let uu___2 = - let uu___3 = - let uu___4 = + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> + let uu___1 = + let uu___2 = + let uu___3 = FStar_Syntax_Syntax.lid_as_fv FStar_Parser_Const.false_lid FStar_Pervasives_Native.None in - FStar_TypeChecker_NBETerm.mkFV uu___4 [] [] in - FStar_TypeChecker_NBETerm.AbstractNBE uu___3 in - FStar_Pervasives_Native.Some uu___2 - | (uu___1, FStar_Syntax_Util.NotEqual) -> + FStar_TypeChecker_NBETerm.mkFV uu___3 [] [] in + FStar_TypeChecker_NBETerm.AbstractNBE uu___2 in + FStar_Pervasives_Native.Some uu___1 + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> + FStar_Pervasives_Native.None +let (s_eq3 : + FStar_TypeChecker_Env.env_t -> + FStar_Syntax_Embeddings.abstract_term -> + FStar_Syntax_Embeddings.abstract_term -> + FStar_Syntax_Embeddings.abstract_term -> + FStar_Syntax_Embeddings.abstract_term -> + FStar_Syntax_Embeddings.abstract_term + FStar_Pervasives_Native.option) + = + fun env -> + fun typ1 -> + fun typ2 -> + fun x -> + fun y -> + let uu___ = + let uu___1 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env + (FStar_Syntax_Embeddings.__proj__Abstract__item__t typ1) + (FStar_Syntax_Embeddings.__proj__Abstract__item__t typ2) in let uu___2 = - let uu___3 = - let uu___4 = - FStar_Syntax_Syntax.lid_as_fv - FStar_Parser_Const.false_lid - FStar_Pervasives_Native.None in - FStar_TypeChecker_NBETerm.mkFV uu___4 [] [] in - FStar_TypeChecker_NBETerm.AbstractNBE uu___3 in - FStar_Pervasives_Native.Some uu___2 - | uu___1 -> FStar_Pervasives_Native.None -let (prop_eq_ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) + FStar_TypeChecker_TermEqAndSimplify.eq_tm env + (FStar_Syntax_Embeddings.__proj__Abstract__item__t x) + (FStar_Syntax_Embeddings.__proj__Abstract__item__t y) in + (uu___1, uu___2) in + match uu___ with + | (FStar_TypeChecker_TermEqAndSimplify.Equal, + FStar_TypeChecker_TermEqAndSimplify.Equal) -> + FStar_Pervasives_Native.Some + (FStar_Syntax_Embeddings.Abstract FStar_Syntax_Util.t_true) + | (FStar_TypeChecker_TermEqAndSimplify.NotEqual, uu___1) -> + FStar_Pervasives_Native.Some + (FStar_Syntax_Embeddings.Abstract FStar_Syntax_Util.t_false) + | (uu___1, FStar_TypeChecker_TermEqAndSimplify.NotEqual) -> + FStar_Pervasives_Native.Some + (FStar_Syntax_Embeddings.Abstract FStar_Syntax_Util.t_false) + | uu___1 -> FStar_Pervasives_Native.None +let (nbe_eq3 : + FStar_TypeChecker_Env.env_t -> + FStar_TypeChecker_NBETerm.abstract_nbe_term -> + FStar_TypeChecker_NBETerm.abstract_nbe_term -> + FStar_TypeChecker_NBETerm.abstract_nbe_term -> + FStar_TypeChecker_NBETerm.abstract_nbe_term -> + FStar_TypeChecker_NBETerm.abstract_nbe_term + FStar_Pervasives_Native.option) = - let uu___ = - FStar_TypeChecker_Primops_Base.mk3' Prims.int_one - FStar_Parser_Const.eq2_lid FStar_Syntax_Embeddings.e_abstract_term - FStar_TypeChecker_NBETerm.e_abstract_nbe_term - FStar_Syntax_Embeddings.e_abstract_term - FStar_TypeChecker_NBETerm.e_abstract_nbe_term - FStar_Syntax_Embeddings.e_abstract_term - FStar_TypeChecker_NBETerm.e_abstract_nbe_term - FStar_Syntax_Embeddings.e_abstract_term - FStar_TypeChecker_NBETerm.e_abstract_nbe_term s_eq2 nbe_eq2 in - let uu___1 = - let uu___2 = - FStar_TypeChecker_Primops_Base.mk4' (Prims.of_int (2)) - FStar_Parser_Const.eq3_lid FStar_Syntax_Embeddings.e_abstract_term - FStar_TypeChecker_NBETerm.e_abstract_nbe_term - FStar_Syntax_Embeddings.e_abstract_term + fun env -> + fun typ1 -> + fun typ2 -> + fun x -> + fun y -> + let uu___ = + let uu___1 = + FStar_TypeChecker_NBETerm.eq_t env + (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t + typ1) + (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t + typ2) in + let uu___2 = + FStar_TypeChecker_NBETerm.eq_t env + (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t x) + (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t y) in + (uu___1, uu___2) in + match uu___ with + | (FStar_TypeChecker_TermEqAndSimplify.Equal, + FStar_TypeChecker_TermEqAndSimplify.Equal) -> + let uu___1 = + let uu___2 = + let uu___3 = + FStar_Syntax_Syntax.lid_as_fv + FStar_Parser_Const.true_lid + FStar_Pervasives_Native.None in + FStar_TypeChecker_NBETerm.mkFV uu___3 [] [] in + FStar_TypeChecker_NBETerm.AbstractNBE uu___2 in + FStar_Pervasives_Native.Some uu___1 + | (FStar_TypeChecker_TermEqAndSimplify.NotEqual, uu___1) -> + let uu___2 = + let uu___3 = + let uu___4 = + FStar_Syntax_Syntax.lid_as_fv + FStar_Parser_Const.false_lid + FStar_Pervasives_Native.None in + FStar_TypeChecker_NBETerm.mkFV uu___4 [] [] in + FStar_TypeChecker_NBETerm.AbstractNBE uu___3 in + FStar_Pervasives_Native.Some uu___2 + | (uu___1, FStar_TypeChecker_TermEqAndSimplify.NotEqual) -> + let uu___2 = + let uu___3 = + let uu___4 = + FStar_Syntax_Syntax.lid_as_fv + FStar_Parser_Const.false_lid + FStar_Pervasives_Native.None in + FStar_TypeChecker_NBETerm.mkFV uu___4 [] [] in + FStar_TypeChecker_NBETerm.AbstractNBE uu___3 in + FStar_Pervasives_Native.Some uu___2 + | uu___1 -> FStar_Pervasives_Native.None +let (prop_eq_ops : + FStar_TypeChecker_Env.env_t -> + FStar_TypeChecker_Primops_Base.primitive_step Prims.list) + = + fun env -> + let uu___ = + FStar_TypeChecker_Primops_Base.mk3' Prims.int_one + FStar_Parser_Const.eq2_lid FStar_Syntax_Embeddings.e_abstract_term FStar_TypeChecker_NBETerm.e_abstract_nbe_term FStar_Syntax_Embeddings.e_abstract_term FStar_TypeChecker_NBETerm.e_abstract_nbe_term FStar_Syntax_Embeddings.e_abstract_term FStar_TypeChecker_NBETerm.e_abstract_nbe_term FStar_Syntax_Embeddings.e_abstract_term - FStar_TypeChecker_NBETerm.e_abstract_nbe_term s_eq3 nbe_eq3 in - [uu___2] in - uu___ :: uu___1 \ No newline at end of file + FStar_TypeChecker_NBETerm.e_abstract_nbe_term (s_eq2 env) + (nbe_eq2 env) in + let uu___1 = + let uu___2 = + FStar_TypeChecker_Primops_Base.mk4' (Prims.of_int (2)) + FStar_Parser_Const.eq3_lid FStar_Syntax_Embeddings.e_abstract_term + FStar_TypeChecker_NBETerm.e_abstract_nbe_term + FStar_Syntax_Embeddings.e_abstract_term + FStar_TypeChecker_NBETerm.e_abstract_nbe_term + FStar_Syntax_Embeddings.e_abstract_term + FStar_TypeChecker_NBETerm.e_abstract_nbe_term + FStar_Syntax_Embeddings.e_abstract_term + FStar_TypeChecker_NBETerm.e_abstract_nbe_term + FStar_Syntax_Embeddings.e_abstract_term + FStar_TypeChecker_NBETerm.e_abstract_nbe_term (s_eq3 env) + (nbe_eq3 env) in + [uu___2] in + uu___ :: uu___1 \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml index 075f1913578..f92e7d14be5 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml @@ -3199,8 +3199,9 @@ let (head_matches_delta : "FStar.TypeChecker.Rel.norm_with_steps.1" steps env t in let uu___4 = - let uu___5 = FStar_Syntax_Util.eq_tm t t' in - uu___5 = FStar_Syntax_Util.Equal in + let uu___5 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t t' in + uu___5 = FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___4 then FStar_Pervasives_Native.None else @@ -3242,8 +3243,9 @@ let (head_matches_delta : match uu___ with | (head, head') -> let uu___1 = - let uu___2 = FStar_Syntax_Util.eq_tm head head' in - uu___2 = FStar_Syntax_Util.Equal in + let uu___2 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env head head' in + uu___2 = FStar_TypeChecker_TermEqAndSimplify.Equal in Prims.op_Negation uu___1 in let rec aux retry n_delta t11 t21 = let r = head_matches env t11 t21 in @@ -6524,8 +6526,7 @@ and (solve_binders : match (a1, a2) with | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit b1), FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Implicit b2)) -> - FStar_Syntax_Util.Equal + (FStar_Syntax_Syntax.Implicit b2)) -> true | uu___1 -> FStar_Syntax_Util.eq_bqual a1 a2 in let compat_positivity_qualifiers p1 p2 = match p_rel orig with @@ -6552,10 +6553,9 @@ and (solve_binders : (let formula = p_guard rhs_prob in ((FStar_Pervasives.Inl ([rhs_prob], formula)), wl2)))) | (x::xs1, y::ys1) when - (let uu___1 = - eq_bqual x.FStar_Syntax_Syntax.binder_qual - y.FStar_Syntax_Syntax.binder_qual in - uu___1 = FStar_Syntax_Util.Equal) && + (eq_bqual x.FStar_Syntax_Syntax.binder_qual + y.FStar_Syntax_Syntax.binder_qual) + && (compat_positivity_qualifiers x.FStar_Syntax_Syntax.binder_positivity y.FStar_Syntax_Syntax.binder_positivity) @@ -6823,8 +6823,10 @@ and (solve_t_flex_rigid_eq : (fun x -> fun y -> let uu___7 = - FStar_Syntax_Util.eq_tm x y in - uu___7 = FStar_Syntax_Util.Equal) + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env x y in + uu___7 = + FStar_TypeChecker_TermEqAndSimplify.Equal) b.FStar_Syntax_Syntax.binder_attrs a.FStar_Syntax_Syntax.aqual_attributes) | uu___6 -> false in @@ -7527,10 +7529,10 @@ and (solve_t_flex_rigid_eq : let uu___17 = FStar_Syntax_Util.ctx_uvar_typ ctx_uv in - FStar_Syntax_Util.eq_tm - t_head uu___17 in + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env t_head uu___17 in uu___16 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___15 then solve_sub_probs_if_head_types_equal @@ -8196,8 +8198,10 @@ and (solve_t' : tprob -> worklist -> solution) = else (let uu___5 = (nargs = Prims.int_zero) || - (let uu___6 = FStar_Syntax_Util.eq_args args1 args2 in - uu___6 = FStar_Syntax_Util.Equal) in + (let uu___6 = + FStar_TypeChecker_TermEqAndSimplify.eq_args env + args1 args2 in + uu___6 = FStar_TypeChecker_TermEqAndSimplify.Equal) in if uu___5 then (if need_unif1 @@ -8399,19 +8403,21 @@ and (solve_t' : tprob -> worklist -> solution) = -> let uu___16 = let uu___17 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env1 head1' head1 in let uu___18 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env1 head2' head2 in (uu___17, uu___18) in (match uu___16 with - | (FStar_Syntax_Util.Equal, - FStar_Syntax_Util.Equal) + | (FStar_TypeChecker_TermEqAndSimplify.Equal, + FStar_TypeChecker_TermEqAndSimplify.Equal) -> ((let uu___18 = @@ -10656,11 +10662,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -10668,7 +10676,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -10677,8 +10684,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -10792,11 +10801,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -10804,7 +10815,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -10813,8 +10823,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -10928,11 +10940,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -10940,7 +10954,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -10949,8 +10962,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11064,11 +11079,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11076,7 +11093,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11085,8 +11101,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11200,11 +11218,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11212,7 +11232,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11221,8 +11240,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11336,11 +11357,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11348,7 +11371,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11357,8 +11379,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11472,11 +11496,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11484,7 +11510,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11493,8 +11518,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11608,11 +11635,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11620,7 +11649,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11629,8 +11657,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11744,11 +11774,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11756,7 +11788,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11765,8 +11796,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11880,11 +11913,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11892,7 +11927,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11901,8 +11935,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -12016,11 +12052,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -12028,7 +12066,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -12037,8 +12074,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -12152,11 +12191,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -12164,7 +12205,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -12173,8 +12213,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcEffect.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcEffect.ml index 226e42cdf27..279718c6c74 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcEffect.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcEffect.ml @@ -692,11 +692,12 @@ let (bind_combinator_kind : = let uu___14 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env g_sig_b_arrow_t (g_b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in uu___14 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___13 then @@ -706,11 +707,12 @@ let (bind_combinator_kind : = let uu___16 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env g_sig_b_sort (g_b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in uu___16 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___15 then @@ -963,11 +965,12 @@ let (bind_combinator_kind : = let uu___15 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env (f_b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort expected_f_b_sort in uu___15 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___14 then @@ -1190,11 +1193,12 @@ let (bind_combinator_kind : = let uu___16 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env (g_b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort expected_g_b_sort in uu___16 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___15 then @@ -1923,11 +1927,12 @@ let (subcomp_combinator_kind : uu___8 uu___9 in let uu___8 = let uu___9 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env (f_b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort expected_f_b_sort in uu___9 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___8 then FStar_Pervasives_Native.Some @@ -2052,12 +2057,13 @@ let (subcomp_combinator_kind : uu___9 in let uu___8 = let uu___9 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env (FStar_Syntax_Util.comp_result k_c) expected_t in uu___9 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___8 then FStar_Pervasives_Native.Some @@ -2668,11 +2674,12 @@ let (ite_combinator_kind : FStar_Compiler_Range_Type.dummyRange in let uu___10 = let uu___11 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env (f_b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort expected_f_b_sort in uu___11 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___10 then FStar_Pervasives_Native.Some @@ -2731,11 +2738,12 @@ let (ite_combinator_kind : FStar_Compiler_Range_Type.dummyRange in let uu___10 = let uu___11 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env (g_b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort expected_g_b_sort in uu___11 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___10 then FStar_Pervasives_Native.Some @@ -3465,10 +3473,12 @@ let (lift_combinator_kind : uu___8 in let uu___7 = let uu___8 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env (f_b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort expected_f_b_sort in - uu___8 = FStar_Syntax_Util.Equal in + uu___8 = + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___7 then FStar_Pervasives_Native.Some () else FStar_Pervasives_Native.None in @@ -7530,7 +7540,8 @@ let (tc_non_layered_eff_decl : = let uu___21 = FStar_Compiler_Util.for_some - (FStar_Syntax_Util.attr_eq + (FStar_TypeChecker_TermEqAndSimplify.eq_tm_bool + env FStar_Syntax_Util.dm4f_bind_range_attr) ed2.FStar_Syntax_Syntax.eff_attrs in if uu___21 diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml index aeadfe2bf63..cc3b5c5ecc1 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml @@ -1341,8 +1341,10 @@ let (guard_letrecs : FStar_Syntax_Util.unrefine uu___ in let rec warn t11 t21 = let uu___ = - let uu___1 = FStar_Syntax_Util.eq_tm t11 t21 in - uu___1 = FStar_Syntax_Util.Equal in + let uu___1 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env2 t11 + t21 in + uu___1 = FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___ then false else @@ -1531,8 +1533,10 @@ let (guard_letrecs : uu___1 :: uu___2 in FStar_Syntax_Syntax.mk_Tm_app rel uu___ r in let uu___ = - let uu___1 = FStar_Syntax_Util.eq_tm rel rel_prev in - uu___1 = FStar_Syntax_Util.Equal in + let uu___1 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env2 rel + rel_prev in + uu___1 = FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___ then rel_guard else @@ -5996,7 +6000,7 @@ and (tc_abs_check_binders : let uu___2 = (Prims.op_Negation (special imp imp')) && (let uu___3 = FStar_Syntax_Util.eq_bqual imp imp' in - uu___3 <> FStar_Syntax_Util.Equal) in + Prims.op_Negation uu___3) in if uu___2 then let uu___3 = @@ -6128,9 +6132,10 @@ and (tc_abs_check_binders : FStar_Compiler_List.existsb (fun attr -> let uu___5 = - FStar_Syntax_Util.eq_tm attr - attr' in - uu___5 = FStar_Syntax_Util.Equal) + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env1 attr attr' in + uu___5 = + FStar_TypeChecker_TermEqAndSimplify.Equal) attrs1 in Prims.op_Negation uu___4) attrs'1 in FStar_Compiler_List.op_At attrs1 diff in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml new file mode 100644 index 00000000000..cd2b0c70cef --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml @@ -0,0 +1,1303 @@ +open Prims +type eq_result = + | Equal + | NotEqual + | Unknown +let (uu___is_Equal : eq_result -> Prims.bool) = + fun projectee -> match projectee with | Equal -> true | uu___ -> false +let (uu___is_NotEqual : eq_result -> Prims.bool) = + fun projectee -> match projectee with | NotEqual -> true | uu___ -> false +let (uu___is_Unknown : eq_result -> Prims.bool) = + fun projectee -> match projectee with | Unknown -> true | uu___ -> false +let (injectives : Prims.string Prims.list) = + ["FStar.Int8.int_to_t"; + "FStar.Int16.int_to_t"; + "FStar.Int32.int_to_t"; + "FStar.Int64.int_to_t"; + "FStar.Int128.int_to_t"; + "FStar.UInt8.uint_to_t"; + "FStar.UInt16.uint_to_t"; + "FStar.UInt32.uint_to_t"; + "FStar.UInt64.uint_to_t"; + "FStar.UInt128.uint_to_t"; + "FStar.SizeT.uint_to_t"; + "FStar.Int8.__int_to_t"; + "FStar.Int16.__int_to_t"; + "FStar.Int32.__int_to_t"; + "FStar.Int64.__int_to_t"; + "FStar.Int128.__int_to_t"; + "FStar.UInt8.__uint_to_t"; + "FStar.UInt16.__uint_to_t"; + "FStar.UInt32.__uint_to_t"; + "FStar.UInt64.__uint_to_t"; + "FStar.UInt128.__uint_to_t"; + "FStar.SizeT.__uint_to_t"] +let (eq_inj : eq_result -> eq_result -> eq_result) = + fun r -> + fun s -> + match (r, s) with + | (Equal, Equal) -> Equal + | (NotEqual, uu___) -> NotEqual + | (uu___, NotEqual) -> NotEqual + | (uu___, uu___1) -> Unknown +let (equal_if : Prims.bool -> eq_result) = + fun uu___ -> if uu___ then Equal else Unknown +let (equal_iff : Prims.bool -> eq_result) = + fun uu___ -> if uu___ then Equal else NotEqual +let (eq_and : eq_result -> (unit -> eq_result) -> eq_result) = + fun r -> + fun s -> + let uu___ = (r = Equal) && (let uu___1 = s () in uu___1 = Equal) in + if uu___ then Equal else Unknown +let rec (eq_tm : + FStar_TypeChecker_Env.env_t -> + FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> eq_result) + = + fun env -> + fun t1 -> + fun t2 -> + let eq_tm1 = eq_tm env in + let t11 = FStar_Syntax_Util.canon_app t1 in + let t21 = FStar_Syntax_Util.canon_app t2 in + let equal_data f1 args1 f2 args2 = + let uu___ = FStar_Syntax_Syntax.fv_eq f1 f2 in + if uu___ + then + let uu___1 = FStar_Compiler_List.zip args1 args2 in + FStar_Compiler_List.fold_left + (fun acc -> + fun uu___2 -> + match uu___2 with + | ((a1, q1), (a2, q2)) -> + let uu___3 = eq_tm1 a1 a2 in eq_inj acc uu___3) Equal + uu___1 + else NotEqual in + let qual_is_inj uu___ = + match uu___ with + | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Data_ctor) -> + true + | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor + uu___1) -> true + | uu___1 -> false in + let heads_and_args_in_case_both_data = + let uu___ = + let uu___1 = FStar_Syntax_Util.unmeta t11 in + FStar_Syntax_Util.head_and_args uu___1 in + match uu___ with + | (head1, args1) -> + let uu___1 = + let uu___2 = FStar_Syntax_Util.unmeta t21 in + FStar_Syntax_Util.head_and_args uu___2 in + (match uu___1 with + | (head2, args2) -> + let uu___2 = + let uu___3 = + let uu___4 = FStar_Syntax_Util.un_uinst head1 in + uu___4.FStar_Syntax_Syntax.n in + let uu___4 = + let uu___5 = FStar_Syntax_Util.un_uinst head2 in + uu___5.FStar_Syntax_Syntax.n in + (uu___3, uu___4) in + (match uu___2 with + | (FStar_Syntax_Syntax.Tm_fvar f, + FStar_Syntax_Syntax.Tm_fvar g) when + (qual_is_inj f.FStar_Syntax_Syntax.fv_qual) && + (qual_is_inj g.FStar_Syntax_Syntax.fv_qual) + -> FStar_Pervasives_Native.Some (f, args1, g, args2) + | uu___3 -> FStar_Pervasives_Native.None)) in + let t12 = FStar_Syntax_Util.unmeta t11 in + let t22 = FStar_Syntax_Util.unmeta t21 in + match ((t12.FStar_Syntax_Syntax.n), (t22.FStar_Syntax_Syntax.n)) with + | (FStar_Syntax_Syntax.Tm_bvar bv1, FStar_Syntax_Syntax.Tm_bvar bv2) + -> + equal_if + (bv1.FStar_Syntax_Syntax.index = bv2.FStar_Syntax_Syntax.index) + | (FStar_Syntax_Syntax.Tm_lazy uu___, uu___1) -> + let uu___2 = FStar_Syntax_Util.unlazy t12 in eq_tm1 uu___2 t22 + | (uu___, FStar_Syntax_Syntax.Tm_lazy uu___1) -> + let uu___2 = FStar_Syntax_Util.unlazy t22 in eq_tm1 t12 uu___2 + | (FStar_Syntax_Syntax.Tm_name a, FStar_Syntax_Syntax.Tm_name b) -> + let uu___ = FStar_Syntax_Syntax.bv_eq a b in equal_if uu___ + | uu___ when + FStar_Pervasives_Native.uu___is_Some + heads_and_args_in_case_both_data + -> + let uu___1 = + FStar_Compiler_Util.must heads_and_args_in_case_both_data in + (match uu___1 with + | (f, args1, g, args2) -> equal_data f args1 g args2) + | (FStar_Syntax_Syntax.Tm_fvar f, FStar_Syntax_Syntax.Tm_fvar g) -> + let uu___ = FStar_Syntax_Syntax.fv_eq f g in equal_if uu___ + | (FStar_Syntax_Syntax.Tm_uinst (f, us), FStar_Syntax_Syntax.Tm_uinst + (g, vs)) -> + let uu___ = eq_tm1 f g in + eq_and uu___ + (fun uu___1 -> + let uu___2 = FStar_Syntax_Util.eq_univs_list us vs in + equal_if uu___2) + | (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range uu___), + FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range uu___1)) + -> Unknown + | (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_real r1), + FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_real r2)) -> + equal_if (r1 = r2) + | (FStar_Syntax_Syntax.Tm_constant c, FStar_Syntax_Syntax.Tm_constant + d) -> let uu___ = FStar_Const.eq_const c d in equal_iff uu___ + | (FStar_Syntax_Syntax.Tm_uvar (u1, ([], uu___)), + FStar_Syntax_Syntax.Tm_uvar (u2, ([], uu___1))) -> + let uu___2 = + FStar_Syntax_Unionfind.equiv + u1.FStar_Syntax_Syntax.ctx_uvar_head + u2.FStar_Syntax_Syntax.ctx_uvar_head in + equal_if uu___2 + | (FStar_Syntax_Syntax.Tm_app + { FStar_Syntax_Syntax.hd = h1; FStar_Syntax_Syntax.args = args1;_}, + FStar_Syntax_Syntax.Tm_app + { FStar_Syntax_Syntax.hd = h2; FStar_Syntax_Syntax.args = args2;_}) + -> + let uu___ = + let uu___1 = + let uu___2 = FStar_Syntax_Util.un_uinst h1 in + uu___2.FStar_Syntax_Syntax.n in + let uu___2 = + let uu___3 = FStar_Syntax_Util.un_uinst h2 in + uu___3.FStar_Syntax_Syntax.n in + (uu___1, uu___2) in + (match uu___ with + | (FStar_Syntax_Syntax.Tm_fvar f1, FStar_Syntax_Syntax.Tm_fvar + f2) when + (FStar_Syntax_Syntax.fv_eq f1 f2) && + (let uu___1 = + let uu___2 = FStar_Syntax_Syntax.lid_of_fv f1 in + FStar_Ident.string_of_lid uu___2 in + FStar_Compiler_List.mem uu___1 injectives) + -> equal_data f1 args1 f2 args2 + | uu___1 -> + let uu___2 = eq_tm1 h1 h2 in + eq_and uu___2 (fun uu___3 -> eq_args env args1 args2)) + | (FStar_Syntax_Syntax.Tm_match + { FStar_Syntax_Syntax.scrutinee = t13; + FStar_Syntax_Syntax.ret_opt = uu___; + FStar_Syntax_Syntax.brs = bs1; + FStar_Syntax_Syntax.rc_opt1 = uu___1;_}, + FStar_Syntax_Syntax.Tm_match + { FStar_Syntax_Syntax.scrutinee = t23; + FStar_Syntax_Syntax.ret_opt = uu___2; + FStar_Syntax_Syntax.brs = bs2; + FStar_Syntax_Syntax.rc_opt1 = uu___3;_}) + -> + if + (FStar_Compiler_List.length bs1) = + (FStar_Compiler_List.length bs2) + then + let uu___4 = FStar_Compiler_List.zip bs1 bs2 in + let uu___5 = eq_tm1 t13 t23 in + FStar_Compiler_List.fold_right + (fun uu___6 -> + fun a -> + match uu___6 with + | (b1, b2) -> + eq_and a (fun uu___7 -> branch_matches env b1 b2)) + uu___4 uu___5 + else Unknown + | (FStar_Syntax_Syntax.Tm_type u, FStar_Syntax_Syntax.Tm_type v) -> + let uu___ = FStar_Syntax_Util.eq_univs u v in equal_if uu___ + | (FStar_Syntax_Syntax.Tm_quoted (t13, q1), + FStar_Syntax_Syntax.Tm_quoted (t23, q2)) -> Unknown + | (FStar_Syntax_Syntax.Tm_refine + { FStar_Syntax_Syntax.b = t13; FStar_Syntax_Syntax.phi = phi1;_}, + FStar_Syntax_Syntax.Tm_refine + { FStar_Syntax_Syntax.b = t23; FStar_Syntax_Syntax.phi = phi2;_}) + -> + let uu___ = + eq_tm1 t13.FStar_Syntax_Syntax.sort + t23.FStar_Syntax_Syntax.sort in + eq_and uu___ (fun uu___1 -> eq_tm1 phi1 phi2) + | (FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = bs1; FStar_Syntax_Syntax.body = body1; + FStar_Syntax_Syntax.rc_opt = uu___;_}, + FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = bs2; FStar_Syntax_Syntax.body = body2; + FStar_Syntax_Syntax.rc_opt = uu___1;_}) + when + (FStar_Compiler_List.length bs1) = + (FStar_Compiler_List.length bs2) + -> + let uu___2 = + FStar_Compiler_List.fold_left2 + (fun r -> + fun b1 -> + fun b2 -> + eq_and r + (fun uu___3 -> + eq_tm1 + (b1.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort + (b2.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort)) + Equal bs1 bs2 in + eq_and uu___2 (fun uu___3 -> eq_tm1 body1 body2) + | (FStar_Syntax_Syntax.Tm_arrow + { FStar_Syntax_Syntax.bs1 = bs1; FStar_Syntax_Syntax.comp = c1;_}, + FStar_Syntax_Syntax.Tm_arrow + { FStar_Syntax_Syntax.bs1 = bs2; FStar_Syntax_Syntax.comp = c2;_}) + when + (FStar_Compiler_List.length bs1) = + (FStar_Compiler_List.length bs2) + -> + let uu___ = + FStar_Compiler_List.fold_left2 + (fun r -> + fun b1 -> + fun b2 -> + eq_and r + (fun uu___1 -> + eq_tm1 + (b1.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort + (b2.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort)) + Equal bs1 bs2 in + eq_and uu___ (fun uu___1 -> eq_comp env c1 c2) + | uu___ -> Unknown +and (eq_antiquotations : + FStar_TypeChecker_Env.env_t -> + FStar_Syntax_Syntax.term Prims.list -> + FStar_Syntax_Syntax.term Prims.list -> eq_result) + = + fun env -> + fun a1 -> + fun a2 -> + match (a1, a2) with + | ([], []) -> Equal + | ([], uu___) -> NotEqual + | (uu___, []) -> NotEqual + | (t1::a11, t2::a21) -> + let uu___ = eq_tm env t1 t2 in + (match uu___ with + | NotEqual -> NotEqual + | Unknown -> + let uu___1 = eq_antiquotations env a11 a21 in + (match uu___1 with + | NotEqual -> NotEqual + | uu___2 -> Unknown) + | Equal -> eq_antiquotations env a11 a21) +and (branch_matches : + FStar_TypeChecker_Env.env_t -> + (FStar_Syntax_Syntax.pat' FStar_Syntax_Syntax.withinfo_t * + FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax + FStar_Pervasives_Native.option * FStar_Syntax_Syntax.term' + FStar_Syntax_Syntax.syntax) -> + (FStar_Syntax_Syntax.pat' FStar_Syntax_Syntax.withinfo_t * + FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax + FStar_Pervasives_Native.option * FStar_Syntax_Syntax.term' + FStar_Syntax_Syntax.syntax) -> eq_result) + = + fun env -> + fun b1 -> + fun b2 -> + let related_by f o1 o2 = + match (o1, o2) with + | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> + true + | (FStar_Pervasives_Native.Some x, FStar_Pervasives_Native.Some y) + -> f x y + | (uu___, uu___1) -> false in + let uu___ = b1 in + match uu___ with + | (p1, w1, t1) -> + let uu___1 = b2 in + (match uu___1 with + | (p2, w2, t2) -> + let uu___2 = FStar_Syntax_Syntax.eq_pat p1 p2 in + if uu___2 + then + let uu___3 = + (let uu___4 = eq_tm env t1 t2 in uu___4 = Equal) && + (related_by + (fun t11 -> + fun t21 -> + let uu___4 = eq_tm env t11 t21 in + uu___4 = Equal) w1 w2) in + (if uu___3 then Equal else Unknown) + else Unknown) +and (eq_args : + FStar_TypeChecker_Env.env_t -> + FStar_Syntax_Syntax.args -> FStar_Syntax_Syntax.args -> eq_result) + = + fun env -> + fun a1 -> + fun a2 -> + match (a1, a2) with + | ([], []) -> Equal + | ((a, uu___)::a11, (b, uu___1)::b1) -> + let uu___2 = eq_tm env a b in + (match uu___2 with + | Equal -> eq_args env a11 b1 + | uu___3 -> Unknown) + | uu___ -> Unknown +and (eq_comp : + FStar_TypeChecker_Env.env_t -> + FStar_Syntax_Syntax.comp -> FStar_Syntax_Syntax.comp -> eq_result) + = + fun env -> + fun c1 -> + fun c2 -> + match ((c1.FStar_Syntax_Syntax.n), (c2.FStar_Syntax_Syntax.n)) with + | (FStar_Syntax_Syntax.Total t1, FStar_Syntax_Syntax.Total t2) -> + eq_tm env t1 t2 + | (FStar_Syntax_Syntax.GTotal t1, FStar_Syntax_Syntax.GTotal t2) -> + eq_tm env t1 t2 + | (FStar_Syntax_Syntax.Comp ct1, FStar_Syntax_Syntax.Comp ct2) -> + let uu___ = + let uu___1 = + FStar_Syntax_Util.eq_univs_list + ct1.FStar_Syntax_Syntax.comp_univs + ct2.FStar_Syntax_Syntax.comp_univs in + equal_if uu___1 in + eq_and uu___ + (fun uu___1 -> + let uu___2 = + let uu___3 = + FStar_Ident.lid_equals + ct1.FStar_Syntax_Syntax.effect_name + ct2.FStar_Syntax_Syntax.effect_name in + equal_if uu___3 in + eq_and uu___2 + (fun uu___3 -> + let uu___4 = + eq_tm env ct1.FStar_Syntax_Syntax.result_typ + ct2.FStar_Syntax_Syntax.result_typ in + eq_and uu___4 + (fun uu___5 -> + eq_args env ct1.FStar_Syntax_Syntax.effect_args + ct2.FStar_Syntax_Syntax.effect_args))) + | uu___ -> NotEqual +let (eq_tm_bool : + FStar_TypeChecker_Env.env_t -> + FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> Prims.bool) + = fun e -> fun t1 -> fun t2 -> let uu___ = eq_tm e t1 t2 in uu___ = Equal +let (simplify : + Prims.bool -> + FStar_TypeChecker_Env.env_t -> + FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term) + = + fun debug -> + fun env -> + fun tm -> + let w t = + { + FStar_Syntax_Syntax.n = (t.FStar_Syntax_Syntax.n); + FStar_Syntax_Syntax.pos = (tm.FStar_Syntax_Syntax.pos); + FStar_Syntax_Syntax.vars = (t.FStar_Syntax_Syntax.vars); + FStar_Syntax_Syntax.hash_code = (t.FStar_Syntax_Syntax.hash_code) + } in + let simp_t t = + let uu___ = + let uu___1 = FStar_Syntax_Util.unmeta t in + uu___1.FStar_Syntax_Syntax.n in + match uu___ with + | FStar_Syntax_Syntax.Tm_fvar fv when + FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.true_lid -> + FStar_Pervasives_Native.Some true + | FStar_Syntax_Syntax.Tm_fvar fv when + FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.false_lid + -> FStar_Pervasives_Native.Some false + | uu___1 -> FStar_Pervasives_Native.None in + let rec args_are_binders args bs = + match (args, bs) with + | ((t, uu___)::args1, b::bs1) -> + let uu___1 = + let uu___2 = FStar_Syntax_Subst.compress t in + uu___2.FStar_Syntax_Syntax.n in + (match uu___1 with + | FStar_Syntax_Syntax.Tm_name bv' -> + (FStar_Syntax_Syntax.bv_eq b.FStar_Syntax_Syntax.binder_bv + bv') + && (args_are_binders args1 bs1) + | uu___2 -> false) + | ([], []) -> true + | (uu___, uu___1) -> false in + let is_applied bs t = + if debug + then + (let uu___1 = FStar_Syntax_Print.term_to_string t in + let uu___2 = FStar_Syntax_Print.tag_of_term t in + FStar_Compiler_Util.print2 "WPE> is_applied %s -- %s\n" uu___1 + uu___2) + else (); + (let uu___1 = FStar_Syntax_Util.head_and_args_full t in + match uu___1 with + | (hd, args) -> + let uu___2 = + let uu___3 = FStar_Syntax_Subst.compress hd in + uu___3.FStar_Syntax_Syntax.n in + (match uu___2 with + | FStar_Syntax_Syntax.Tm_name bv when + args_are_binders args bs -> + (if debug + then + (let uu___4 = FStar_Syntax_Print.term_to_string t in + let uu___5 = FStar_Syntax_Print.bv_to_string bv in + let uu___6 = FStar_Syntax_Print.term_to_string hd in + FStar_Compiler_Util.print3 + "WPE> got it\n>>>>top = %s\n>>>>b = %s\n>>>>hd = %s\n" + uu___4 uu___5 uu___6) + else (); + FStar_Pervasives_Native.Some bv) + | uu___3 -> FStar_Pervasives_Native.None)) in + let is_applied_maybe_squashed bs t = + if debug + then + (let uu___1 = FStar_Syntax_Print.term_to_string t in + let uu___2 = FStar_Syntax_Print.tag_of_term t in + FStar_Compiler_Util.print2 + "WPE> is_applied_maybe_squashed %s -- %s\n" uu___1 uu___2) + else (); + (let uu___1 = FStar_Syntax_Util.is_squash t in + match uu___1 with + | FStar_Pervasives_Native.Some (uu___2, t') -> is_applied bs t' + | uu___2 -> + let uu___3 = FStar_Syntax_Util.is_auto_squash t in + (match uu___3 with + | FStar_Pervasives_Native.Some (uu___4, t') -> + is_applied bs t' + | uu___4 -> is_applied bs t)) in + let is_const_match phi = + let uu___ = + let uu___1 = FStar_Syntax_Subst.compress phi in + uu___1.FStar_Syntax_Syntax.n in + match uu___ with + | FStar_Syntax_Syntax.Tm_match + { FStar_Syntax_Syntax.scrutinee = uu___1; + FStar_Syntax_Syntax.ret_opt = uu___2; + FStar_Syntax_Syntax.brs = br::brs; + FStar_Syntax_Syntax.rc_opt1 = uu___3;_} + -> + let uu___4 = br in + (match uu___4 with + | (uu___5, uu___6, e) -> + let r = + let uu___7 = simp_t e in + match uu___7 with + | FStar_Pervasives_Native.None -> + FStar_Pervasives_Native.None + | FStar_Pervasives_Native.Some b -> + let uu___8 = + FStar_Compiler_List.for_all + (fun uu___9 -> + match uu___9 with + | (uu___10, uu___11, e') -> + let uu___12 = simp_t e' in + uu___12 = + (FStar_Pervasives_Native.Some b)) brs in + if uu___8 + then FStar_Pervasives_Native.Some b + else FStar_Pervasives_Native.None in + r) + | uu___1 -> FStar_Pervasives_Native.None in + let maybe_auto_squash t = + let uu___ = FStar_Syntax_Util.is_sub_singleton t in + if uu___ + then t + else FStar_Syntax_Util.mk_auto_squash FStar_Syntax_Syntax.U_zero t in + let squashed_head_un_auto_squash_args t = + let maybe_un_auto_squash_arg uu___ = + match uu___ with + | (t1, q) -> + let uu___1 = FStar_Syntax_Util.is_auto_squash t1 in + (match uu___1 with + | FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.U_zero, t2) -> (t2, q) + | uu___2 -> (t1, q)) in + let uu___ = FStar_Syntax_Util.head_and_args t in + match uu___ with + | (head, args) -> + let args1 = + FStar_Compiler_List.map maybe_un_auto_squash_arg args in + FStar_Syntax_Syntax.mk_Tm_app head args1 + t.FStar_Syntax_Syntax.pos in + let rec clearly_inhabited ty = + let uu___ = + let uu___1 = FStar_Syntax_Util.unmeta ty in + uu___1.FStar_Syntax_Syntax.n in + match uu___ with + | FStar_Syntax_Syntax.Tm_uinst (t, uu___1) -> clearly_inhabited t + | FStar_Syntax_Syntax.Tm_arrow + { FStar_Syntax_Syntax.bs1 = uu___1; + FStar_Syntax_Syntax.comp = c;_} + -> clearly_inhabited (FStar_Syntax_Util.comp_result c) + | FStar_Syntax_Syntax.Tm_fvar fv -> + let l = FStar_Syntax_Syntax.lid_of_fv fv in + (((FStar_Ident.lid_equals l FStar_Parser_Const.int_lid) || + (FStar_Ident.lid_equals l FStar_Parser_Const.bool_lid)) + || (FStar_Ident.lid_equals l FStar_Parser_Const.string_lid)) + || (FStar_Ident.lid_equals l FStar_Parser_Const.exn_lid) + | uu___1 -> false in + let simplify1 arg = + let uu___ = simp_t (FStar_Pervasives_Native.fst arg) in + (uu___, arg) in + let uu___ = + let uu___1 = FStar_Syntax_Subst.compress tm in + uu___1.FStar_Syntax_Syntax.n in + match uu___ with + | FStar_Syntax_Syntax.Tm_app + { + FStar_Syntax_Syntax.hd = + { + FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_uinst + ({ + FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; + FStar_Syntax_Syntax.pos = uu___1; + FStar_Syntax_Syntax.vars = uu___2; + FStar_Syntax_Syntax.hash_code = uu___3;_}, + uu___4); + FStar_Syntax_Syntax.pos = uu___5; + FStar_Syntax_Syntax.vars = uu___6; + FStar_Syntax_Syntax.hash_code = uu___7;_}; + FStar_Syntax_Syntax.args = args;_} + -> + let uu___8 = + FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.and_lid in + if uu___8 + then + let uu___9 = FStar_Compiler_List.map simplify1 args in + (match uu___9 with + | (FStar_Pervasives_Native.Some (true), uu___10)::(uu___11, + (arg, + uu___12))::[] + -> maybe_auto_squash arg + | (uu___10, (arg, uu___11))::(FStar_Pervasives_Native.Some + (true), uu___12)::[] + -> maybe_auto_squash arg + | (FStar_Pervasives_Native.Some (false), uu___10)::uu___11::[] + -> w FStar_Syntax_Util.t_false + | uu___10::(FStar_Pervasives_Native.Some (false), uu___11)::[] + -> w FStar_Syntax_Util.t_false + | uu___10 -> squashed_head_un_auto_squash_args tm) + else + (let uu___10 = + FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.or_lid in + if uu___10 + then + let uu___11 = FStar_Compiler_List.map simplify1 args in + match uu___11 with + | (FStar_Pervasives_Native.Some (true), uu___12)::uu___13::[] + -> w FStar_Syntax_Util.t_true + | uu___12::(FStar_Pervasives_Native.Some (true), uu___13)::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (false), uu___12)::(uu___13, + (arg, + uu___14))::[] + -> maybe_auto_squash arg + | (uu___12, (arg, uu___13))::(FStar_Pervasives_Native.Some + (false), uu___14)::[] + -> maybe_auto_squash arg + | uu___12 -> squashed_head_un_auto_squash_args tm + else + (let uu___12 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.imp_lid in + if uu___12 + then + let uu___13 = FStar_Compiler_List.map simplify1 args in + match uu___13 with + | uu___14::(FStar_Pervasives_Native.Some (true), uu___15)::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (false), uu___14)::uu___15::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (true), uu___14):: + (uu___15, (arg, uu___16))::[] -> + maybe_auto_squash arg + | (uu___14, (p, uu___15))::(uu___16, (q, uu___17))::[] -> + let uu___18 = FStar_Syntax_Util.term_eq p q in + (if uu___18 + then w FStar_Syntax_Util.t_true + else squashed_head_un_auto_squash_args tm) + | uu___14 -> squashed_head_un_auto_squash_args tm + else + (let uu___14 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.iff_lid in + if uu___14 + then + let uu___15 = FStar_Compiler_List.map simplify1 args in + match uu___15 with + | (FStar_Pervasives_Native.Some (true), uu___16):: + (FStar_Pervasives_Native.Some (true), uu___17)::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (false), uu___16):: + (FStar_Pervasives_Native.Some (false), uu___17)::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (true), uu___16):: + (FStar_Pervasives_Native.Some (false), uu___17)::[] + -> w FStar_Syntax_Util.t_false + | (FStar_Pervasives_Native.Some (false), uu___16):: + (FStar_Pervasives_Native.Some (true), uu___17)::[] + -> w FStar_Syntax_Util.t_false + | (uu___16, (arg, uu___17))::(FStar_Pervasives_Native.Some + (true), uu___18)::[] + -> maybe_auto_squash arg + | (FStar_Pervasives_Native.Some (true), uu___16):: + (uu___17, (arg, uu___18))::[] -> + maybe_auto_squash arg + | (uu___16, (arg, uu___17))::(FStar_Pervasives_Native.Some + (false), uu___18)::[] + -> + let uu___19 = FStar_Syntax_Util.mk_neg arg in + maybe_auto_squash uu___19 + | (FStar_Pervasives_Native.Some (false), uu___16):: + (uu___17, (arg, uu___18))::[] -> + let uu___19 = FStar_Syntax_Util.mk_neg arg in + maybe_auto_squash uu___19 + | (uu___16, (p, uu___17))::(uu___18, (q, uu___19))::[] + -> + let uu___20 = FStar_Syntax_Util.term_eq p q in + (if uu___20 + then w FStar_Syntax_Util.t_true + else squashed_head_un_auto_squash_args tm) + | uu___16 -> squashed_head_un_auto_squash_args tm + else + (let uu___16 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.not_lid in + if uu___16 + then + let uu___17 = + FStar_Compiler_List.map simplify1 args in + match uu___17 with + | (FStar_Pervasives_Native.Some (true), uu___18)::[] + -> w FStar_Syntax_Util.t_false + | (FStar_Pervasives_Native.Some (false), uu___18)::[] + -> w FStar_Syntax_Util.t_true + | uu___18 -> squashed_head_un_auto_squash_args tm + else + (let uu___18 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.forall_lid in + if uu___18 + then + match args with + | (t, uu___19)::[] -> + let uu___20 = + let uu___21 = + FStar_Syntax_Subst.compress t in + uu___21.FStar_Syntax_Syntax.n in + (match uu___20 with + | FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = uu___21::[]; + FStar_Syntax_Syntax.body = body; + FStar_Syntax_Syntax.rc_opt = uu___22;_} + -> + let uu___23 = simp_t body in + (match uu___23 with + | FStar_Pervasives_Native.Some (true) + -> w FStar_Syntax_Util.t_true + | uu___24 -> tm) + | uu___21 -> tm) + | (ty, FStar_Pervasives_Native.Some + { FStar_Syntax_Syntax.aqual_implicit = true; + FStar_Syntax_Syntax.aqual_attributes = + uu___19;_})::(t, uu___20)::[] + -> + let uu___21 = + let uu___22 = + FStar_Syntax_Subst.compress t in + uu___22.FStar_Syntax_Syntax.n in + (match uu___21 with + | FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = uu___22::[]; + FStar_Syntax_Syntax.body = body; + FStar_Syntax_Syntax.rc_opt = uu___23;_} + -> + let uu___24 = simp_t body in + (match uu___24 with + | FStar_Pervasives_Native.Some (true) + -> w FStar_Syntax_Util.t_true + | FStar_Pervasives_Native.Some (false) + when clearly_inhabited ty -> + w FStar_Syntax_Util.t_false + | uu___25 -> tm) + | uu___22 -> tm) + | uu___19 -> tm + else + (let uu___20 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.exists_lid in + if uu___20 + then + match args with + | (t, uu___21)::[] -> + let uu___22 = + let uu___23 = + FStar_Syntax_Subst.compress t in + uu___23.FStar_Syntax_Syntax.n in + (match uu___22 with + | FStar_Syntax_Syntax.Tm_abs + { + FStar_Syntax_Syntax.bs = + uu___23::[]; + FStar_Syntax_Syntax.body = body; + FStar_Syntax_Syntax.rc_opt = + uu___24;_} + -> + let uu___25 = simp_t body in + (match uu___25 with + | FStar_Pervasives_Native.Some + (false) -> + w FStar_Syntax_Util.t_false + | uu___26 -> tm) + | uu___23 -> tm) + | (ty, FStar_Pervasives_Native.Some + { + FStar_Syntax_Syntax.aqual_implicit = + true; + FStar_Syntax_Syntax.aqual_attributes = + uu___21;_})::(t, uu___22)::[] + -> + let uu___23 = + let uu___24 = + FStar_Syntax_Subst.compress t in + uu___24.FStar_Syntax_Syntax.n in + (match uu___23 with + | FStar_Syntax_Syntax.Tm_abs + { + FStar_Syntax_Syntax.bs = + uu___24::[]; + FStar_Syntax_Syntax.body = body; + FStar_Syntax_Syntax.rc_opt = + uu___25;_} + -> + let uu___26 = simp_t body in + (match uu___26 with + | FStar_Pervasives_Native.Some + (false) -> + w FStar_Syntax_Util.t_false + | FStar_Pervasives_Native.Some + (true) when + clearly_inhabited ty -> + w FStar_Syntax_Util.t_true + | uu___27 -> tm) + | uu___24 -> tm) + | uu___21 -> tm + else + (let uu___22 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.b2t_lid in + if uu___22 + then + match args with + | ({ + FStar_Syntax_Syntax.n = + FStar_Syntax_Syntax.Tm_constant + (FStar_Const.Const_bool (true)); + FStar_Syntax_Syntax.pos = uu___23; + FStar_Syntax_Syntax.vars = uu___24; + FStar_Syntax_Syntax.hash_code = + uu___25;_}, + uu___26)::[] -> + w FStar_Syntax_Util.t_true + | ({ + FStar_Syntax_Syntax.n = + FStar_Syntax_Syntax.Tm_constant + (FStar_Const.Const_bool (false)); + FStar_Syntax_Syntax.pos = uu___23; + FStar_Syntax_Syntax.vars = uu___24; + FStar_Syntax_Syntax.hash_code = + uu___25;_}, + uu___26)::[] -> + w FStar_Syntax_Util.t_false + | uu___23 -> tm + else + (let uu___24 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.haseq_lid in + if uu___24 + then + let t_has_eq_for_sure t = + let haseq_lids = + [FStar_Parser_Const.int_lid; + FStar_Parser_Const.bool_lid; + FStar_Parser_Const.unit_lid; + FStar_Parser_Const.string_lid] in + let uu___25 = + let uu___26 = + FStar_Syntax_Subst.compress t in + uu___26.FStar_Syntax_Syntax.n in + match uu___25 with + | FStar_Syntax_Syntax.Tm_fvar fv1 + when + FStar_Compiler_List.existsb + (fun l -> + FStar_Syntax_Syntax.fv_eq_lid + fv1 l) haseq_lids + -> true + | uu___26 -> false in + (if + (FStar_Compiler_List.length args) = + Prims.int_one + then + let t = + let uu___25 = + FStar_Compiler_List.hd args in + FStar_Pervasives_Native.fst + uu___25 in + let uu___25 = t_has_eq_for_sure t in + (if uu___25 + then w FStar_Syntax_Util.t_true + else + (let uu___27 = + let uu___28 = + FStar_Syntax_Subst.compress + t in + uu___28.FStar_Syntax_Syntax.n in + match uu___27 with + | FStar_Syntax_Syntax.Tm_refine + uu___28 -> + let t1 = + FStar_Syntax_Util.unrefine + t in + let uu___29 = + t_has_eq_for_sure t1 in + if uu___29 + then + w FStar_Syntax_Util.t_true + else + (let haseq_tm = + let uu___31 = + let uu___32 = + FStar_Syntax_Subst.compress + tm in + uu___32.FStar_Syntax_Syntax.n in + match uu___31 with + | FStar_Syntax_Syntax.Tm_app + { + FStar_Syntax_Syntax.hd + = hd; + FStar_Syntax_Syntax.args + = uu___32;_} + -> hd + | uu___32 -> + FStar_Compiler_Effect.failwith + "Impossible! We have already checked that this is a Tm_app" in + let uu___31 = + let uu___32 = + FStar_Syntax_Syntax.as_arg + t1 in + [uu___32] in + FStar_Syntax_Util.mk_app + haseq_tm uu___31) + | uu___28 -> tm)) + else tm) + else + (let uu___26 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.eq2_lid in + if uu___26 + then + match args with + | (_typ, uu___27)::(a1, uu___28):: + (a2, uu___29)::[] -> + let uu___30 = eq_tm env a1 a2 in + (match uu___30 with + | Equal -> + w FStar_Syntax_Util.t_true + | NotEqual -> + w FStar_Syntax_Util.t_false + | uu___31 -> tm) + | uu___27 -> tm + else + (let uu___28 = + FStar_Syntax_Util.is_auto_squash + tm in + match uu___28 with + | FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.U_zero, t) + when + FStar_Syntax_Util.is_sub_singleton + t + -> t + | uu___29 -> tm)))))))))) + | FStar_Syntax_Syntax.Tm_app + { + FStar_Syntax_Syntax.hd = + { FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; + FStar_Syntax_Syntax.pos = uu___1; + FStar_Syntax_Syntax.vars = uu___2; + FStar_Syntax_Syntax.hash_code = uu___3;_}; + FStar_Syntax_Syntax.args = args;_} + -> + let uu___4 = + FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.and_lid in + if uu___4 + then + let uu___5 = FStar_Compiler_List.map simplify1 args in + (match uu___5 with + | (FStar_Pervasives_Native.Some (true), uu___6)::(uu___7, + (arg, + uu___8))::[] + -> maybe_auto_squash arg + | (uu___6, (arg, uu___7))::(FStar_Pervasives_Native.Some + (true), uu___8)::[] + -> maybe_auto_squash arg + | (FStar_Pervasives_Native.Some (false), uu___6)::uu___7::[] + -> w FStar_Syntax_Util.t_false + | uu___6::(FStar_Pervasives_Native.Some (false), uu___7)::[] + -> w FStar_Syntax_Util.t_false + | uu___6 -> squashed_head_un_auto_squash_args tm) + else + (let uu___6 = + FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.or_lid in + if uu___6 + then + let uu___7 = FStar_Compiler_List.map simplify1 args in + match uu___7 with + | (FStar_Pervasives_Native.Some (true), uu___8)::uu___9::[] + -> w FStar_Syntax_Util.t_true + | uu___8::(FStar_Pervasives_Native.Some (true), uu___9)::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (false), uu___8)::(uu___9, + (arg, + uu___10))::[] + -> maybe_auto_squash arg + | (uu___8, (arg, uu___9))::(FStar_Pervasives_Native.Some + (false), uu___10)::[] + -> maybe_auto_squash arg + | uu___8 -> squashed_head_un_auto_squash_args tm + else + (let uu___8 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.imp_lid in + if uu___8 + then + let uu___9 = FStar_Compiler_List.map simplify1 args in + match uu___9 with + | uu___10::(FStar_Pervasives_Native.Some (true), uu___11)::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (false), uu___10)::uu___11::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (true), uu___10):: + (uu___11, (arg, uu___12))::[] -> + maybe_auto_squash arg + | (uu___10, (p, uu___11))::(uu___12, (q, uu___13))::[] -> + let uu___14 = FStar_Syntax_Util.term_eq p q in + (if uu___14 + then w FStar_Syntax_Util.t_true + else squashed_head_un_auto_squash_args tm) + | uu___10 -> squashed_head_un_auto_squash_args tm + else + (let uu___10 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.iff_lid in + if uu___10 + then + let uu___11 = FStar_Compiler_List.map simplify1 args in + match uu___11 with + | (FStar_Pervasives_Native.Some (true), uu___12):: + (FStar_Pervasives_Native.Some (true), uu___13)::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (false), uu___12):: + (FStar_Pervasives_Native.Some (false), uu___13)::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (true), uu___12):: + (FStar_Pervasives_Native.Some (false), uu___13)::[] + -> w FStar_Syntax_Util.t_false + | (FStar_Pervasives_Native.Some (false), uu___12):: + (FStar_Pervasives_Native.Some (true), uu___13)::[] + -> w FStar_Syntax_Util.t_false + | (uu___12, (arg, uu___13))::(FStar_Pervasives_Native.Some + (true), uu___14)::[] + -> maybe_auto_squash arg + | (FStar_Pervasives_Native.Some (true), uu___12):: + (uu___13, (arg, uu___14))::[] -> + maybe_auto_squash arg + | (uu___12, (arg, uu___13))::(FStar_Pervasives_Native.Some + (false), uu___14)::[] + -> + let uu___15 = FStar_Syntax_Util.mk_neg arg in + maybe_auto_squash uu___15 + | (FStar_Pervasives_Native.Some (false), uu___12):: + (uu___13, (arg, uu___14))::[] -> + let uu___15 = FStar_Syntax_Util.mk_neg arg in + maybe_auto_squash uu___15 + | (uu___12, (p, uu___13))::(uu___14, (q, uu___15))::[] + -> + let uu___16 = FStar_Syntax_Util.term_eq p q in + (if uu___16 + then w FStar_Syntax_Util.t_true + else squashed_head_un_auto_squash_args tm) + | uu___12 -> squashed_head_un_auto_squash_args tm + else + (let uu___12 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.not_lid in + if uu___12 + then + let uu___13 = + FStar_Compiler_List.map simplify1 args in + match uu___13 with + | (FStar_Pervasives_Native.Some (true), uu___14)::[] + -> w FStar_Syntax_Util.t_false + | (FStar_Pervasives_Native.Some (false), uu___14)::[] + -> w FStar_Syntax_Util.t_true + | uu___14 -> squashed_head_un_auto_squash_args tm + else + (let uu___14 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.forall_lid in + if uu___14 + then + match args with + | (t, uu___15)::[] -> + let uu___16 = + let uu___17 = + FStar_Syntax_Subst.compress t in + uu___17.FStar_Syntax_Syntax.n in + (match uu___16 with + | FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = uu___17::[]; + FStar_Syntax_Syntax.body = body; + FStar_Syntax_Syntax.rc_opt = uu___18;_} + -> + let uu___19 = simp_t body in + (match uu___19 with + | FStar_Pervasives_Native.Some (true) + -> w FStar_Syntax_Util.t_true + | uu___20 -> tm) + | uu___17 -> tm) + | (ty, FStar_Pervasives_Native.Some + { FStar_Syntax_Syntax.aqual_implicit = true; + FStar_Syntax_Syntax.aqual_attributes = + uu___15;_})::(t, uu___16)::[] + -> + let uu___17 = + let uu___18 = + FStar_Syntax_Subst.compress t in + uu___18.FStar_Syntax_Syntax.n in + (match uu___17 with + | FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = uu___18::[]; + FStar_Syntax_Syntax.body = body; + FStar_Syntax_Syntax.rc_opt = uu___19;_} + -> + let uu___20 = simp_t body in + (match uu___20 with + | FStar_Pervasives_Native.Some (true) + -> w FStar_Syntax_Util.t_true + | FStar_Pervasives_Native.Some (false) + when clearly_inhabited ty -> + w FStar_Syntax_Util.t_false + | uu___21 -> tm) + | uu___18 -> tm) + | uu___15 -> tm + else + (let uu___16 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.exists_lid in + if uu___16 + then + match args with + | (t, uu___17)::[] -> + let uu___18 = + let uu___19 = + FStar_Syntax_Subst.compress t in + uu___19.FStar_Syntax_Syntax.n in + (match uu___18 with + | FStar_Syntax_Syntax.Tm_abs + { + FStar_Syntax_Syntax.bs = + uu___19::[]; + FStar_Syntax_Syntax.body = body; + FStar_Syntax_Syntax.rc_opt = + uu___20;_} + -> + let uu___21 = simp_t body in + (match uu___21 with + | FStar_Pervasives_Native.Some + (false) -> + w FStar_Syntax_Util.t_false + | uu___22 -> tm) + | uu___19 -> tm) + | (ty, FStar_Pervasives_Native.Some + { + FStar_Syntax_Syntax.aqual_implicit = + true; + FStar_Syntax_Syntax.aqual_attributes = + uu___17;_})::(t, uu___18)::[] + -> + let uu___19 = + let uu___20 = + FStar_Syntax_Subst.compress t in + uu___20.FStar_Syntax_Syntax.n in + (match uu___19 with + | FStar_Syntax_Syntax.Tm_abs + { + FStar_Syntax_Syntax.bs = + uu___20::[]; + FStar_Syntax_Syntax.body = body; + FStar_Syntax_Syntax.rc_opt = + uu___21;_} + -> + let uu___22 = simp_t body in + (match uu___22 with + | FStar_Pervasives_Native.Some + (false) -> + w FStar_Syntax_Util.t_false + | FStar_Pervasives_Native.Some + (true) when + clearly_inhabited ty -> + w FStar_Syntax_Util.t_true + | uu___23 -> tm) + | uu___20 -> tm) + | uu___17 -> tm + else + (let uu___18 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.b2t_lid in + if uu___18 + then + match args with + | ({ + FStar_Syntax_Syntax.n = + FStar_Syntax_Syntax.Tm_constant + (FStar_Const.Const_bool (true)); + FStar_Syntax_Syntax.pos = uu___19; + FStar_Syntax_Syntax.vars = uu___20; + FStar_Syntax_Syntax.hash_code = + uu___21;_}, + uu___22)::[] -> + w FStar_Syntax_Util.t_true + | ({ + FStar_Syntax_Syntax.n = + FStar_Syntax_Syntax.Tm_constant + (FStar_Const.Const_bool (false)); + FStar_Syntax_Syntax.pos = uu___19; + FStar_Syntax_Syntax.vars = uu___20; + FStar_Syntax_Syntax.hash_code = + uu___21;_}, + uu___22)::[] -> + w FStar_Syntax_Util.t_false + | uu___19 -> tm + else + (let uu___20 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.haseq_lid in + if uu___20 + then + let t_has_eq_for_sure t = + let haseq_lids = + [FStar_Parser_Const.int_lid; + FStar_Parser_Const.bool_lid; + FStar_Parser_Const.unit_lid; + FStar_Parser_Const.string_lid] in + let uu___21 = + let uu___22 = + FStar_Syntax_Subst.compress t in + uu___22.FStar_Syntax_Syntax.n in + match uu___21 with + | FStar_Syntax_Syntax.Tm_fvar fv1 + when + FStar_Compiler_List.existsb + (fun l -> + FStar_Syntax_Syntax.fv_eq_lid + fv1 l) haseq_lids + -> true + | uu___22 -> false in + (if + (FStar_Compiler_List.length args) = + Prims.int_one + then + let t = + let uu___21 = + FStar_Compiler_List.hd args in + FStar_Pervasives_Native.fst + uu___21 in + let uu___21 = t_has_eq_for_sure t in + (if uu___21 + then w FStar_Syntax_Util.t_true + else + (let uu___23 = + let uu___24 = + FStar_Syntax_Subst.compress + t in + uu___24.FStar_Syntax_Syntax.n in + match uu___23 with + | FStar_Syntax_Syntax.Tm_refine + uu___24 -> + let t1 = + FStar_Syntax_Util.unrefine + t in + let uu___25 = + t_has_eq_for_sure t1 in + if uu___25 + then + w FStar_Syntax_Util.t_true + else + (let haseq_tm = + let uu___27 = + let uu___28 = + FStar_Syntax_Subst.compress + tm in + uu___28.FStar_Syntax_Syntax.n in + match uu___27 with + | FStar_Syntax_Syntax.Tm_app + { + FStar_Syntax_Syntax.hd + = hd; + FStar_Syntax_Syntax.args + = uu___28;_} + -> hd + | uu___28 -> + FStar_Compiler_Effect.failwith + "Impossible! We have already checked that this is a Tm_app" in + let uu___27 = + let uu___28 = + FStar_Syntax_Syntax.as_arg + t1 in + [uu___28] in + FStar_Syntax_Util.mk_app + haseq_tm uu___27) + | uu___24 -> tm)) + else tm) + else + (let uu___22 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.eq2_lid in + if uu___22 + then + match args with + | (_typ, uu___23)::(a1, uu___24):: + (a2, uu___25)::[] -> + let uu___26 = eq_tm env a1 a2 in + (match uu___26 with + | Equal -> + w FStar_Syntax_Util.t_true + | NotEqual -> + w FStar_Syntax_Util.t_false + | uu___27 -> tm) + | uu___23 -> tm + else + (let uu___24 = + FStar_Syntax_Util.is_auto_squash + tm in + match uu___24 with + | FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.U_zero, t) + when + FStar_Syntax_Util.is_sub_singleton + t + -> t + | uu___25 -> tm)))))))))) + | FStar_Syntax_Syntax.Tm_refine + { FStar_Syntax_Syntax.b = bv; FStar_Syntax_Syntax.phi = t;_} -> + let uu___1 = simp_t t in + (match uu___1 with + | FStar_Pervasives_Native.Some (true) -> + bv.FStar_Syntax_Syntax.sort + | FStar_Pervasives_Native.Some (false) -> tm + | FStar_Pervasives_Native.None -> tm) + | FStar_Syntax_Syntax.Tm_match uu___1 -> + let uu___2 = is_const_match tm in + (match uu___2 with + | FStar_Pervasives_Native.Some (true) -> + w FStar_Syntax_Util.t_true + | FStar_Pervasives_Native.Some (false) -> + w FStar_Syntax_Util.t_false + | FStar_Pervasives_Native.None -> tm) + | uu___1 -> tm \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml index 3c638a5388f..58d65c13a78 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml @@ -5908,8 +5908,11 @@ let (weaken_result_typ : let set_result_typ c1 = FStar_Syntax_Util.set_result_typ c1 t in let uu___4 = - let uu___5 = FStar_Syntax_Util.eq_tm t res_t in - uu___5 = FStar_Syntax_Util.Equal in + let uu___5 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env + t res_t in + uu___5 = + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___4 then ((let uu___6 = @@ -6507,11 +6510,9 @@ let (maybe_instantiate : FStar_Syntax_Syntax.binder_positivity = uu___5; FStar_Syntax_Syntax.binder_attrs = uu___6;_} -> (FStar_Compiler_Option.isNone imp) || - (let uu___7 = - FStar_Syntax_Util.eq_bqual imp - (FStar_Pervasives_Native.Some - FStar_Syntax_Syntax.Equality) in - uu___7 = FStar_Syntax_Util.Equal)) formals in + (FStar_Syntax_Util.eq_bqual imp + (FStar_Pervasives_Native.Some + FStar_Syntax_Syntax.Equality))) formals in match uu___2 with | FStar_Pervasives_Native.None -> FStar_Compiler_List.length formals diff --git a/ocaml/fstar-tests/generated/FStar_Tests_Util.ml b/ocaml/fstar-tests/generated/FStar_Tests_Util.ml index 2c8c8f06c83..9dc829fbdca 100644 --- a/ocaml/fstar-tests/generated/FStar_Tests_Util.ml +++ b/ocaml/fstar-tests/generated/FStar_Tests_Util.ml @@ -69,9 +69,8 @@ let rec (term_eq' : fun uu___1 -> match (uu___, uu___1) with | ((a, imp), (b, imp')) -> - (term_eq' a b) && - (let uu___2 = FStar_Syntax_Util.eq_aqual imp imp' in - uu___2 = FStar_Syntax_Util.Equal)) xs ys) in + (term_eq' a b) && (FStar_Syntax_Util.eq_aqual imp imp')) + xs ys) in let comp_eq c d = match ((c.FStar_Syntax_Syntax.n), (d.FStar_Syntax_Syntax.n)) with | (FStar_Syntax_Syntax.Total t, FStar_Syntax_Syntax.Total s) -> diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index b2f58d850f7..d0b6baf3355 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -42,6 +42,7 @@ module SS = FStar.Syntax.Subst module TcUtil = FStar.TypeChecker.Util module UF = FStar.Syntax.Unionfind module U = FStar.Syntax.Util +module TEQ = FStar.TypeChecker.TermEqAndSimplify let norm_before_encoding env t = let steps = [Env.Eager_unfolding; @@ -1408,9 +1409,9 @@ let encode_datacon (is_injective_on_tparams:bool) (env:env_t) (se:sigelt) let head, _ = U.head_and_args t in let t' = norm t in let head', _ = U.head_and_args t' in - match U.eq_tm head head' with - | U.Equal -> None //no progress after whnf - | U.NotEqual -> binder_and_codomain_type t' + match TEQ.eq_tm env.tcenv head head' with + | TEQ.Equal -> None //no progress after whnf + | TEQ.NotEqual -> binder_and_codomain_type t' | _ -> //Did we actually make progress? Be conservative to avoid an infinite loop match (SS.compress head).n with diff --git a/src/syntax/FStar.Syntax.Util.fst b/src/syntax/FStar.Syntax.Util.fst index 3f608f402cf..3b19e04cbe8 100644 --- a/src/syntax/FStar.Syntax.Util.fst +++ b/src/syntax/FStar.Syntax.Util.fst @@ -222,6 +222,10 @@ let rec compare_univs (u1:universe) (u2:universe) : int = let eq_univs u1 u2 = compare_univs u1 u2 = 0 +let eq_univs_list (us:universes) (vs:universes) : bool = + List.length us = List.length vs + && List.forall2 eq_univs us vs + (********************************************************************************) (*********************** Utilities for computation types ************************) (********************************************************************************) @@ -496,313 +500,272 @@ let canon_app t = let hd, args = head_and_args_full (unascribe t) in mk_Tm_app hd args t.pos -(* ---------------------------------------------------------------------- *) -(* Syntactic equality of terms *) -(* ---------------------------------------------------------------------- *) -type eq_result = - | Equal - | NotEqual - | Unknown - -// Functions that we specially treat as injective, to make normalization -// (particularly of decidable equality) better. We should make sure they -// are actually proved to be injective. -let injectives = - ["FStar.Int8.int_to_t"; - "FStar.Int16.int_to_t"; - "FStar.Int32.int_to_t"; - "FStar.Int64.int_to_t"; - "FStar.Int128.int_to_t"; - "FStar.UInt8.uint_to_t"; - "FStar.UInt16.uint_to_t"; - "FStar.UInt32.uint_to_t"; - "FStar.UInt64.uint_to_t"; - "FStar.UInt128.uint_to_t"; - "FStar.SizeT.uint_to_t"; - "FStar.Int8.__int_to_t"; - "FStar.Int16.__int_to_t"; - "FStar.Int32.__int_to_t"; - "FStar.Int64.__int_to_t"; - "FStar.Int128.__int_to_t"; - "FStar.UInt8.__uint_to_t"; - "FStar.UInt16.__uint_to_t"; - "FStar.UInt32.__uint_to_t"; - "FStar.UInt64.__uint_to_t"; - "FStar.UInt128.__uint_to_t"; - "FStar.SizeT.__uint_to_t"; - ] - -// Compose two eq_result injectively, as in a pair -let eq_inj r s = - match r, s with - | Equal, Equal -> Equal - | NotEqual, _ - | _, NotEqual -> NotEqual - | _, _ -> Unknown - -// Promote a bool to eq_result, conservatively. -let equal_if = function - | true -> Equal - | _ -> Unknown - -// Promote a bool to an eq_result, taking a false to bet NotEqual. -// This is only useful for fully decidable equalities. -// Use with care, see note about Const_real below and #2806. -let equal_iff = function - | true -> Equal - | _ -> NotEqual - -// Compose two equality results, NOT assuming a NotEqual implies anything. -// This is useful, e.g., for checking the equality of applications. Consider -// f x ~ g y -// if f=g and x=y then we know these two expressions are equal, but cannot say -// anything when either result is NotEqual or Unknown, hence this returns Unknown -// in most cases. -// The second comparison is thunked for efficiency. -let eq_and r s = - if r = Equal && s () = Equal - then Equal - else Unknown - -(* Precondition: terms are well-typed in a common environment, or this can return false positives *) -let rec eq_tm (t1:term) (t2:term) : eq_result = - let t1 = canon_app t1 in - let t2 = canon_app t2 in - let equal_data (f1:fv) (args1:Syntax.args) (f2:fv) (args2:Syntax.args) = - // we got constructors! we know they are injective and disjoint, so we can do some - // good analysis on them - if fv_eq f1 f2 - then ( - assert (List.length args1 = List.length args2); - List.fold_left (fun acc ((a1, q1), (a2, q2)) -> - //if q1 <> q2 - //then failwith (U.format1 "Arguments of %s mismatch on implicit qualifier\n" - // (Ident.string_of_lid f1.fv_name.v)); - //NS: 05/06/2018 ...this does not always hold - // it's been succeeding because the assert is disabled in the non-debug builds - //assert (q1 = q2); - eq_inj acc (eq_tm a1 a2)) Equal <| List.zip args1 args2 - ) else NotEqual - in - let qual_is_inj = function - | Some Data_ctor - | Some (Record_ctor _) -> true - | _ -> false - in - let heads_and_args_in_case_both_data :option (fv * args * fv * args) = - let head1, args1 = t1 |> unmeta |> head_and_args in - let head2, args2 = t2 |> unmeta |> head_and_args in - match (un_uinst head1).n, (un_uinst head2).n with - | Tm_fvar f, Tm_fvar g when qual_is_inj f.fv_qual && - qual_is_inj g.fv_qual -> Some (f, args1, g, args2) - | _ -> None - in - let t1 = unmeta t1 in - let t2 = unmeta t2 in - match t1.n, t2.n with - // We sometimes compare open terms, as we get alpha-equivalence - // for free. - | Tm_bvar bv1, Tm_bvar bv2 -> - equal_if (bv1.index = bv2.index) - - | Tm_lazy _, _ -> eq_tm (unlazy t1) t2 - | _, Tm_lazy _ -> eq_tm t1 (unlazy t2) - - | Tm_name a, Tm_name b -> - equal_if (bv_eq a b) - - | _ when heads_and_args_in_case_both_data |> is_some -> //matches only when both are data constructors - heads_and_args_in_case_both_data |> must |> (fun (f, args1, g, args2) -> - equal_data f args1 g args2 - ) +// (* ---------------------------------------------------------------------- *) +// (* Syntactic equality of terms *) +// (* ---------------------------------------------------------------------- *) +// type eq_result = +// | Equal +// | NotEqual +// | Unknown + +// // Functions that we specially treat as injective, to make normalization +// // (particularly of decidable equality) better. We should make sure they +// // are actually proved to be injective. +// let injectives = +// ["FStar.Int8.int_to_t"; +// "FStar.Int16.int_to_t"; +// "FStar.Int32.int_to_t"; +// "FStar.Int64.int_to_t"; +// "FStar.Int128.int_to_t"; +// "FStar.UInt8.uint_to_t"; +// "FStar.UInt16.uint_to_t"; +// "FStar.UInt32.uint_to_t"; +// "FStar.UInt64.uint_to_t"; +// "FStar.UInt128.uint_to_t"; +// "FStar.SizeT.uint_to_t"; +// "FStar.Int8.__int_to_t"; +// "FStar.Int16.__int_to_t"; +// "FStar.Int32.__int_to_t"; +// "FStar.Int64.__int_to_t"; +// "FStar.Int128.__int_to_t"; +// "FStar.UInt8.__uint_to_t"; +// "FStar.UInt16.__uint_to_t"; +// "FStar.UInt32.__uint_to_t"; +// "FStar.UInt64.__uint_to_t"; +// "FStar.UInt128.__uint_to_t"; +// "FStar.SizeT.__uint_to_t"; +// ] + +// // Compose two eq_result injectively, as in a pair +// let eq_inj r s = +// match r, s with +// | Equal, Equal -> Equal +// | NotEqual, _ +// | _, NotEqual -> NotEqual +// | _, _ -> Unknown + +// // Promote a bool to eq_result, conservatively. +// let equal_if = function +// | true -> Equal +// | _ -> Unknown + +// // Promote a bool to an eq_result, taking a false to bet NotEqual. +// // This is only useful for fully decidable equalities. +// // Use with care, see note about Const_real below and #2806. +// let equal_iff = function +// | true -> Equal +// | _ -> NotEqual + +// // Compose two equality results, NOT assuming a NotEqual implies anything. +// // This is useful, e.g., for checking the equality of applications. Consider +// // f x ~ g y +// // if f=g and x=y then we know these two expressions are equal, but cannot say +// // anything when either result is NotEqual or Unknown, hence this returns Unknown +// // in most cases. +// // The second comparison is thunked for efficiency. +// let eq_and r s = +// if r = Equal && s () = Equal +// then Equal +// else Unknown + +// (* Precondition: terms are well-typed in a common environment, or this can return false positives *) +// let rec eq_tm (t1:term) (t2:term) : eq_result = +// let t1 = canon_app t1 in +// let t2 = canon_app t2 in +// let equal_data (f1:fv) (args1:Syntax.args) (f2:fv) (args2:Syntax.args) = +// // we got constructors! we know they are injective and disjoint, so we can do some +// // good analysis on them +// if fv_eq f1 f2 +// then ( +// assert (List.length args1 = List.length args2); +// List.fold_left (fun acc ((a1, q1), (a2, q2)) -> +// //if q1 <> q2 +// //then failwith (U.format1 "Arguments of %s mismatch on implicit qualifier\n" +// // (Ident.string_of_lid f1.fv_name.v)); +// //NS: 05/06/2018 ...this does not always hold +// // it's been succeeding because the assert is disabled in the non-debug builds +// //assert (q1 = q2); +// eq_inj acc (eq_tm a1 a2)) Equal <| List.zip args1 args2 +// ) else NotEqual +// in +// let qual_is_inj = function +// | Some Data_ctor +// | Some (Record_ctor _) -> true +// | _ -> false +// in +// let heads_and_args_in_case_both_data :option (fv * args * fv * args) = +// let head1, args1 = t1 |> unmeta |> head_and_args in +// let head2, args2 = t2 |> unmeta |> head_and_args in +// match (un_uinst head1).n, (un_uinst head2).n with +// | Tm_fvar f, Tm_fvar g when qual_is_inj f.fv_qual && +// qual_is_inj g.fv_qual -> Some (f, args1, g, args2) +// | _ -> None +// in +// let t1 = unmeta t1 in +// let t2 = unmeta t2 in +// match t1.n, t2.n with +// // We sometimes compare open terms, as we get alpha-equivalence +// // for free. +// | Tm_bvar bv1, Tm_bvar bv2 -> +// equal_if (bv1.index = bv2.index) + +// | Tm_lazy _, _ -> eq_tm (unlazy t1) t2 +// | _, Tm_lazy _ -> eq_tm t1 (unlazy t2) + +// | Tm_name a, Tm_name b -> +// equal_if (bv_eq a b) + +// | _ when heads_and_args_in_case_both_data |> is_some -> //matches only when both are data constructors +// heads_and_args_in_case_both_data |> must |> (fun (f, args1, g, args2) -> +// equal_data f args1 g args2 +// ) + +// | Tm_fvar f, Tm_fvar g -> equal_if (fv_eq f g) + +// | Tm_uinst(f, us), Tm_uinst(g, vs) -> +// // If the fvars and universe instantiations match, then Equal, +// // otherwise Unknown. +// eq_and (eq_tm f g) (fun () -> equal_if (eq_univs_list us vs)) + +// | Tm_constant (Const_range _), Tm_constant (Const_range _) -> +// // Ranges should be opaque, even to the normalizer. c.f. #1312 +// Unknown + +// | Tm_constant (Const_real r1), Tm_constant (Const_real r2) -> +// // We cannot decide equality of reals. Use a conservative approach here. +// // If the strings match, they are equal, otherwise we don't know. If this +// // goes via the eq_iff case below, it will falsely claim that "1.0R" and +// // "01.R" are different, since eq_const does not canonizalize the string +// // representations. +// equal_if (r1 = r2) + +// | Tm_constant c, Tm_constant d -> +// // NOTE: this relies on the fact that eq_const *correctly decides* +// // semantic equality of constants. This needs some care. For instance, +// // since integers are represented by a string, eq_const needs to take care +// // of ignoring leading zeroes, and match 0 with -0. An exception to this +// // are real number literals (handled above). See #2806. +// // +// // Currently (24/Jan/23) this seems to be correctly implemented, but +// // updates should be done with care. +// equal_iff (eq_const c d) + +// | Tm_uvar (u1, ([], _)), Tm_uvar (u2, ([], _)) -> +// equal_if (Unionfind.equiv u1.ctx_uvar_head u2.ctx_uvar_head) + +// | Tm_app {hd=h1; args=args1}, Tm_app {hd=h2; args=args2} -> +// begin match (un_uinst h1).n, (un_uinst h2).n with +// | Tm_fvar f1, Tm_fvar f2 when fv_eq f1 f2 && List.mem (string_of_lid (lid_of_fv f1)) injectives -> +// equal_data f1 args1 f2 args2 + +// | _ -> // can only assert they're equal if they syntactically match, nothing else +// eq_and (eq_tm h1 h2) (fun () -> eq_args args1 args2) +// end + +// | Tm_match {scrutinee=t1; brs=bs1}, Tm_match {scrutinee=t2; brs=bs2} -> //AR: note: no return annotations +// if List.length bs1 = List.length bs2 +// then List.fold_right (fun (b1, b2) a -> eq_and a (fun () -> branch_matches b1 b2)) +// (List.zip bs1 bs2) +// (eq_tm t1 t2) +// else Unknown + +// | Tm_type u, Tm_type v -> +// equal_if (eq_univs u v) + +// | Tm_quoted (t1, q1), Tm_quoted (t2, q2) -> +// // NOTE: we do NOT ever provide a meaningful result for quoted terms. Even +// // if term_eq (the syntactic equality) returns true, that does not mean we +// // can present the equality to userspace since term_eq ignores the names +// // of binders, but the view exposes them. Hence, we simply always return +// // Unknown. We do not seem to rely anywhere on simplifying equalities of +// // quoted literals. See also #2806. +// Unknown + +// | Tm_refine {b=t1; phi=phi1}, Tm_refine {b=t2; phi=phi2} -> +// eq_and (eq_tm t1.sort t2.sort) (fun () -> eq_tm phi1 phi2) + +// (* +// * AR: ignoring residual comp here, that's an ascription added by the typechecker +// * do we care if that's different? +// *) +// | Tm_abs {bs=bs1; body=body1}, Tm_abs {bs=bs2; body=body2} +// when List.length bs1 = List.length bs2 -> + +// eq_and (List.fold_left2 (fun r b1 b2 -> eq_and r (fun () -> eq_tm b1.binder_bv.sort b2.binder_bv.sort)) +// Equal bs1 bs2) +// (fun () -> eq_tm body1 body2) + +// | Tm_arrow {bs=bs1; comp=c1}, Tm_arrow {bs=bs2; comp=c2} +// when List.length bs1 = List.length bs2 -> +// eq_and (List.fold_left2 (fun r b1 b2 -> eq_and r (fun () -> eq_tm b1.binder_bv.sort b2.binder_bv.sort)) +// Equal bs1 bs2) +// (fun () -> eq_comp c1 c2) + +// | _ -> Unknown + +// and eq_antiquotations a1 a2 = +// // Basically this; +// // List.fold_left2 (fun acc t1 t2 -> eq_inj acc (eq_tm t1 t2)) Equal a1 a2 +// // but lazy and handling lists of different size +// match a1, a2 with +// | [], [] -> Equal +// | [], _ +// | _, [] -> NotEqual +// | t1::a1, t2::a2 -> +// match eq_tm t1 t2 with +// | NotEqual -> NotEqual +// | Unknown -> +// (match eq_antiquotations a1 a2 with +// | NotEqual -> NotEqual +// | _ -> Unknown) +// | Equal -> eq_antiquotations a1 a2 + +// and branch_matches b1 b2 = +// let related_by f o1 o2 = +// match o1, o2 with +// | None, None -> true +// | Some x, Some y -> f x y +// | _, _ -> false +// in +// let (p1, w1, t1) = b1 in +// let (p2, w2, t2) = b2 in +// if eq_pat p1 p2 +// then begin +// // We check the `when` branches too, even if unsupported for now +// if eq_tm t1 t2 = Equal && related_by (fun t1 t2 -> eq_tm t1 t2 = Equal) w1 w2 +// then Equal +// else Unknown +// end +// else Unknown + +// and eq_args (a1:args) (a2:args) : eq_result = +// match a1, a2 with +// | [], [] -> Equal +// | (a, _)::a1, (b, _)::b1 -> +// (match eq_tm a b with +// | Equal -> eq_args a1 b1 +// | _ -> Unknown) +// | _ -> Unknown + +// and eq_univs_list (us:universes) (vs:universes) : bool = +// List.length us = List.length vs +// && List.forall2 eq_univs us vs + +// and eq_comp (c1 c2:comp) : eq_result = +// match c1.n, c2.n with +// | Total t1, Total t2 +// | GTotal t1, GTotal t2 -> +// eq_tm t1 t2 +// | Comp ct1, Comp ct2 -> +// eq_and (equal_if (eq_univs_list ct1.comp_univs ct2.comp_univs)) +// (fun _ -> +// eq_and (equal_if (Ident.lid_equals ct1.effect_name ct2.effect_name)) +// (fun _ -> +// eq_and (eq_tm ct1.result_typ ct2.result_typ) +// (fun _ -> eq_args ct1.effect_args ct2.effect_args))) +// //ignoring cflags +// | _ -> NotEqual - | Tm_fvar f, Tm_fvar g -> equal_if (fv_eq f g) - - | Tm_uinst(f, us), Tm_uinst(g, vs) -> - // If the fvars and universe instantiations match, then Equal, - // otherwise Unknown. - eq_and (eq_tm f g) (fun () -> equal_if (eq_univs_list us vs)) - - | Tm_constant (Const_range _), Tm_constant (Const_range _) -> - // Ranges should be opaque, even to the normalizer. c.f. #1312 - Unknown - - | Tm_constant (Const_real r1), Tm_constant (Const_real r2) -> - // We cannot decide equality of reals. Use a conservative approach here. - // If the strings match, they are equal, otherwise we don't know. If this - // goes via the eq_iff case below, it will falsely claim that "1.0R" and - // "01.R" are different, since eq_const does not canonizalize the string - // representations. - equal_if (r1 = r2) - - | Tm_constant c, Tm_constant d -> - // NOTE: this relies on the fact that eq_const *correctly decides* - // semantic equality of constants. This needs some care. For instance, - // since integers are represented by a string, eq_const needs to take care - // of ignoring leading zeroes, and match 0 with -0. An exception to this - // are real number literals (handled above). See #2806. - // - // Currently (24/Jan/23) this seems to be correctly implemented, but - // updates should be done with care. - equal_iff (eq_const c d) - - | Tm_uvar (u1, ([], _)), Tm_uvar (u2, ([], _)) -> - equal_if (Unionfind.equiv u1.ctx_uvar_head u2.ctx_uvar_head) - - | Tm_app {hd=h1; args=args1}, Tm_app {hd=h2; args=args2} -> - begin match (un_uinst h1).n, (un_uinst h2).n with - | Tm_fvar f1, Tm_fvar f2 when fv_eq f1 f2 && List.mem (string_of_lid (lid_of_fv f1)) injectives -> - equal_data f1 args1 f2 args2 - - | _ -> // can only assert they're equal if they syntactically match, nothing else - eq_and (eq_tm h1 h2) (fun () -> eq_args args1 args2) - end - - | Tm_match {scrutinee=t1; brs=bs1}, Tm_match {scrutinee=t2; brs=bs2} -> //AR: note: no return annotations - if List.length bs1 = List.length bs2 - then List.fold_right (fun (b1, b2) a -> eq_and a (fun () -> branch_matches b1 b2)) - (List.zip bs1 bs2) - (eq_tm t1 t2) - else Unknown - - | Tm_type u, Tm_type v -> - equal_if (eq_univs u v) - - | Tm_quoted (t1, q1), Tm_quoted (t2, q2) -> - // NOTE: we do NOT ever provide a meaningful result for quoted terms. Even - // if term_eq (the syntactic equality) returns true, that does not mean we - // can present the equality to userspace since term_eq ignores the names - // of binders, but the view exposes them. Hence, we simply always return - // Unknown. We do not seem to rely anywhere on simplifying equalities of - // quoted literals. See also #2806. - Unknown - - | Tm_refine {b=t1; phi=phi1}, Tm_refine {b=t2; phi=phi2} -> - eq_and (eq_tm t1.sort t2.sort) (fun () -> eq_tm phi1 phi2) - - (* - * AR: ignoring residual comp here, that's an ascription added by the typechecker - * do we care if that's different? - *) - | Tm_abs {bs=bs1; body=body1}, Tm_abs {bs=bs2; body=body2} - when List.length bs1 = List.length bs2 -> - - eq_and (List.fold_left2 (fun r b1 b2 -> eq_and r (fun () -> eq_tm b1.binder_bv.sort b2.binder_bv.sort)) - Equal bs1 bs2) - (fun () -> eq_tm body1 body2) - - | Tm_arrow {bs=bs1; comp=c1}, Tm_arrow {bs=bs2; comp=c2} - when List.length bs1 = List.length bs2 -> - eq_and (List.fold_left2 (fun r b1 b2 -> eq_and r (fun () -> eq_tm b1.binder_bv.sort b2.binder_bv.sort)) - Equal bs1 bs2) - (fun () -> eq_comp c1 c2) - - | _ -> Unknown - -and eq_antiquotations a1 a2 = - // Basically this; - // List.fold_left2 (fun acc t1 t2 -> eq_inj acc (eq_tm t1 t2)) Equal a1 a2 - // but lazy and handling lists of different size - match a1, a2 with - | [], [] -> Equal - | [], _ - | _, [] -> NotEqual - | t1::a1, t2::a2 -> - match eq_tm t1 t2 with - | NotEqual -> NotEqual - | Unknown -> - (match eq_antiquotations a1 a2 with - | NotEqual -> NotEqual - | _ -> Unknown) - | Equal -> eq_antiquotations a1 a2 - -and branch_matches b1 b2 = - let related_by f o1 o2 = - match o1, o2 with - | None, None -> true - | Some x, Some y -> f x y - | _, _ -> false - in - let (p1, w1, t1) = b1 in - let (p2, w2, t2) = b2 in - if eq_pat p1 p2 - then begin - // We check the `when` branches too, even if unsupported for now - if eq_tm t1 t2 = Equal && related_by (fun t1 t2 -> eq_tm t1 t2 = Equal) w1 w2 - then Equal - else Unknown - end - else Unknown - -and eq_args (a1:args) (a2:args) : eq_result = - match a1, a2 with - | [], [] -> Equal - | (a, _)::a1, (b, _)::b1 -> - (match eq_tm a b with - | Equal -> eq_args a1 b1 - | _ -> Unknown) - | _ -> Unknown - -and eq_univs_list (us:universes) (vs:universes) : bool = - List.length us = List.length vs - && List.forall2 eq_univs us vs - -and eq_comp (c1 c2:comp) : eq_result = - match c1.n, c2.n with - | Total t1, Total t2 - | GTotal t1, GTotal t2 -> - eq_tm t1 t2 - | Comp ct1, Comp ct2 -> - eq_and (equal_if (eq_univs_list ct1.comp_univs ct2.comp_univs)) - (fun _ -> - eq_and (equal_if (Ident.lid_equals ct1.effect_name ct2.effect_name)) - (fun _ -> - eq_and (eq_tm ct1.result_typ ct2.result_typ) - (fun _ -> eq_args ct1.effect_args ct2.effect_args))) - //ignoring cflags - | _ -> NotEqual - -(* Only used in term_eq *) -let eq_quoteinfo q1 q2 = - if q1.qkind <> q2.qkind - then NotEqual - else eq_antiquotations (snd q1.antiquotations) (snd q2.antiquotations) - -(* Only used in term_eq *) -let eq_bqual a1 a2 = - match a1, a2 with - | None, None -> Equal - | None, _ - | _, None -> NotEqual - | Some (Implicit b1), Some (Implicit b2) when b1=b2 -> Equal - | Some (Meta t1), Some (Meta t2) -> eq_tm t1 t2 - | Some Equality, Some Equality -> Equal - | _ -> NotEqual - -(* Only used in term_eq *) -let eq_aqual a1 a2 = - match a1, a2 with - | Some a1, Some a2 -> - if a1.aqual_implicit = a2.aqual_implicit - && List.length a1.aqual_attributes = List.length a2.aqual_attributes - then List.fold_left2 - (fun out t1 t2 -> - match out with - | NotEqual -> out - | Unknown -> - (match eq_tm t1 t2 with - | NotEqual -> NotEqual - | _ -> Unknown) - | Equal -> - eq_tm t1 t2) - Equal - a1.aqual_attributes - a2.aqual_attributes - else NotEqual - | None, None -> - Equal - | _ -> - NotEqual let rec unrefine t = @@ -1264,11 +1227,11 @@ let type_u () : typ * universe = let type_with_u (u:universe) : typ = mk (Tm_type u) dummyRange -// works on anything, really -let attr_eq a a' = - match eq_tm a a' with - | Equal -> true - | _ -> false +// // works on anything, really +// let attr_eq a a' = +// match eq_tm a a' with +// | Equal -> true +// | _ -> false let attr_substitute = mk (Tm_fvar (lid_as_fv PC.attr_substitute_lid None)) Range.dummyRange @@ -1716,7 +1679,7 @@ let rec term_eq_dbg (dbg : bool) t1 t2 = check "uvar" (u1.ctx_uvar_head = u2.ctx_uvar_head) | Tm_quoted (qt1, qi1), Tm_quoted (qt2, qi2) -> - (check "tm_quoted qi" (eq_quoteinfo qi1 qi2 = Equal)) && + (check "tm_quoted qi" (quote_info_eq_dbg dbg qi1 qi2)) && (check "tm_quoted payload" (term_eq_dbg dbg qt1 qt2)) | Tm_meta {tm=t1; meta=m1}, Tm_meta {tm=t2; meta=m2} -> @@ -1766,11 +1729,11 @@ let rec term_eq_dbg (dbg : bool) t1 t2 = and arg_eq_dbg (dbg : bool) a1 a2 = eqprod (fun t1 t2 -> check dbg "arg tm" (term_eq_dbg dbg t1 t2)) - (fun q1 q2 -> check dbg "arg qual" (eq_aqual q1 q2 = Equal)) + (fun q1 q2 -> check dbg "arg qual" (aqual_eq_dbg dbg q1 q2)) a1 a2 and binder_eq_dbg (dbg : bool) b1 b2 = (check dbg "binder_sort" (term_eq_dbg dbg b1.binder_bv.sort b2.binder_bv.sort)) && - (check dbg "binder qual" (eq_bqual b1.binder_qual b2.binder_qual = Equal)) && //AR: not checking attributes, should we? + (check dbg "binder qual" (bqual_eq_dbg dbg b1.binder_qual b2.binder_qual)) && //AR: not checking attributes, should we? (check dbg "binder attrs" (eqlist (term_eq_dbg dbg) b1.binder_attrs b2.binder_attrs)) and comp_eq_dbg (dbg : bool) c1 c2 = @@ -1798,6 +1761,56 @@ and letbinding_eq_dbg (dbg : bool) (lb1 : letbinding) lb2 = (check dbg "lb def" (term_eq_dbg dbg lb1.lbdef lb2.lbdef)) // Ignoring eff and attrs.. +and quote_info_eq_dbg (dbg:bool) q1 q2 = + if q1.qkind <> q2.qkind + then false + else antiquotations_eq_dbg dbg (snd q1.antiquotations) (snd q2.antiquotations) + +and antiquotations_eq_dbg (dbg:bool) a1 a2 = + // Basically this; + // List.fold_left2 (fun acc t1 t2 -> eq_inj acc (eq_tm t1 t2)) Equal a1 a2 + // but lazy and handling lists of different size + match a1, a2 with + | [], [] -> true + | [], _ + | _, [] -> false + | t1::a1, t2::a2 -> + if not <| term_eq_dbg dbg t1 t2 + then false + else antiquotations_eq_dbg dbg a1 a2 + +and bqual_eq_dbg dbg a1 a2 = + match a1, a2 with + | None, None -> true + | None, _ + | _, None -> false + | Some (Implicit b1), Some (Implicit b2) when b1=b2 -> true + | Some (Meta t1), Some (Meta t2) -> term_eq_dbg dbg t1 t2 + | Some Equality, Some Equality -> true + | _ -> false + +and aqual_eq_dbg dbg a1 a2 = + match a1, a2 with + | Some a1, Some a2 -> + if a1.aqual_implicit = a2.aqual_implicit + && List.length a1.aqual_attributes = List.length a2.aqual_attributes + then List.fold_left2 + (fun out t1 t2 -> + if not out + then false + else term_eq_dbg dbg t1 t2) + true + a1.aqual_attributes + a2.aqual_attributes + else false + | None, None -> + true + | _ -> + false + +let eq_aqual a1 a2 = aqual_eq_dbg false a1 a2 +let eq_bqual b1 b2 = bqual_eq_dbg false b1 b2 + let term_eq t1 t2 = let r = term_eq_dbg !debug_term_eq t1 t2 in debug_term_eq := false; @@ -2389,7 +2402,7 @@ let is_binder_unused (b:binder) = b.binder_positivity = Some BinderUnused let deduplicate_terms (l:list term) = - FStar.Compiler.List.deduplicate (fun x y -> eq_tm x y = Equal) l + FStar.Compiler.List.deduplicate (fun x y -> term_eq x y) l let eq_binding b1 b2 = match b1, b2 with diff --git a/src/tactics/FStar.Tactics.Hooks.fst b/src/tactics/FStar.Tactics.Hooks.fst index c11516170fa..ae36d646c5e 100644 --- a/src/tactics/FStar.Tactics.Hooks.fst +++ b/src/tactics/FStar.Tactics.Hooks.fst @@ -44,6 +44,7 @@ module Env = FStar.TypeChecker.Env module TcUtil = FStar.TypeChecker.Util module TcRel = FStar.TypeChecker.Rel module TcTerm = FStar.TypeChecker.TcTerm +module TEQ = FStar.TypeChecker.TermEqAndSimplify (* We only use the _abstract_ embeddings from this module, hence there is no v1/v2 distinction. *) @@ -576,7 +577,7 @@ let rec traverse_for_spinoff | Tm_fvar fv, [(t, _)] when simplified && S.fv_eq_lid fv PC.squash_lid && - U.eq_tm t U.t_true = U.Equal -> + TEQ.eq_tm e t U.t_true = TEQ.Equal -> //simplify squash True to True //important for simplifying queries to Trivial if debug then BU.print_string "Simplified squash True to True"; diff --git a/src/tests/FStar.Tests.Util.fst b/src/tests/FStar.Tests.Util.fst index 94afeb89a9a..7961ba068bb 100644 --- a/src/tests/FStar.Tests.Util.fst +++ b/src/tests/FStar.Tests.Util.fst @@ -55,7 +55,7 @@ let rec term_eq' t1 t2 = && List.forall2 (fun (x:binder) (y:binder) -> term_eq' x.binder_bv.sort y.binder_bv.sort) xs ys in let args_eq xs ys = List.length xs = List.length ys - && List.forall2 (fun (a, imp) (b, imp') -> term_eq' a b && U.eq_aqual imp imp'=U.Equal) xs ys in + && List.forall2 (fun (a, imp) (b, imp') -> term_eq' a b && U.eq_aqual imp imp') xs ys in let comp_eq (c:S.comp) (d:S.comp) = match c.n, d.n with | S.Total t, S.Total s -> term_eq' t s diff --git a/src/typechecker/FStar.TypeChecker.Cfg.fst b/src/typechecker/FStar.TypeChecker.Cfg.fst index 5cb7254d97d..39430271921 100644 --- a/src/typechecker/FStar.TypeChecker.Cfg.fst +++ b/src/typechecker/FStar.TypeChecker.Cfg.fst @@ -251,7 +251,8 @@ let prim_from_list (l : list primitive_step) : prim_step_set = (* Turn the lists into psmap sets, for efficiency of lookup *) let built_in_primitive_steps = prim_from_list built_in_primitive_steps_list -let equality_ops = prim_from_list equality_ops_list +let env_dependent_ops env = prim_from_list (env_dependent_ops env) +let equality_ops env = prim_from_list (equality_ops_list env) instance showable_cfg : showable cfg = { show = (fun cfg -> @@ -373,7 +374,7 @@ let config' psteps s e = | [] -> [Env.NoDelta] | _ -> d in let steps = to_fsteps s |> add_nbe in - let psteps = add_steps (cached_steps ()) psteps in + let psteps = add_steps (merge_steps (cached_steps ()) (env_dependent_ops e))psteps in let dbg_flag = List.contains NormDebug s in {tcenv = e; debug = if dbg_flag || Options.debug_any () then diff --git a/src/typechecker/FStar.TypeChecker.Cfg.fsti b/src/typechecker/FStar.TypeChecker.Cfg.fsti index d5683f2f060..7843a7808eb 100644 --- a/src/typechecker/FStar.TypeChecker.Cfg.fsti +++ b/src/typechecker/FStar.TypeChecker.Cfg.fsti @@ -137,7 +137,7 @@ val find_prim_step: cfg -> fv -> option primitive_step // val try_unembed_simple: EMB.embedding 'a -> term -> option 'a val built_in_primitive_steps : BU.psmap primitive_step -val equality_ops : BU.psmap primitive_step +val equality_ops (env:Env.env_t): BU.psmap primitive_step val register_plugin: primitive_step -> unit val register_extra_step: primitive_step -> unit diff --git a/src/typechecker/FStar.TypeChecker.Common.fst b/src/typechecker/FStar.TypeChecker.Common.fst index 1a25708ce24..9f844bed437 100644 --- a/src/typechecker/FStar.TypeChecker.Common.fst +++ b/src/typechecker/FStar.TypeChecker.Common.fst @@ -350,270 +350,6 @@ let lcomp_of_comp_guard c0 g = let lcomp_of_comp c0 = lcomp_of_comp_guard c0 trivial_guard -//////////////////////////////////////////////////////////////////////////////// -// Core logical simplification of terms -//////////////////////////////////////////////////////////////////////////////// -module SS = FStar.Syntax.Subst -open FStar.Syntax.Util -open FStar.Const -let simplify (debug:bool) (tm:term) : term = - let w t = {t with pos=tm.pos} in - let simp_t t = - // catch annotated subformulae too - match (U.unmeta t).n with - | Tm_fvar fv when S.fv_eq_lid fv PC.true_lid -> Some true - | Tm_fvar fv when S.fv_eq_lid fv PC.false_lid -> Some false - | _ -> None - in - let rec args_are_binders args bs = - match args, bs with - | (t, _)::args, b::bs -> - begin match (SS.compress t).n with - | Tm_name bv' -> S.bv_eq b.binder_bv bv' && args_are_binders args bs - | _ -> false - end - | [], [] -> true - | _, _ -> false - in - let is_applied (bs:binders) (t : term) : option bv = - if debug then - BU.print2 "WPE> is_applied %s -- %s\n" (Print.term_to_string t) (Print.tag_of_term t); - let hd, args = U.head_and_args_full t in - match (SS.compress hd).n with - | Tm_name bv when args_are_binders args bs -> - if debug then - BU.print3 "WPE> got it\n>>>>top = %s\n>>>>b = %s\n>>>>hd = %s\n" - (Print.term_to_string t) - (Print.bv_to_string bv) - (Print.term_to_string hd); - Some bv - | _ -> None - in - let is_applied_maybe_squashed (bs : binders) (t : term) : option bv = - if debug then - BU.print2 "WPE> is_applied_maybe_squashed %s -- %s\n" (Print.term_to_string t) (Print.tag_of_term t); - match is_squash t with - - | Some (_, t') -> is_applied bs t' - | _ -> begin match is_auto_squash t with - | Some (_, t') -> is_applied bs t' - | _ -> is_applied bs t - end - in - let is_const_match (phi : term) : option bool = - match (SS.compress phi).n with - (* Trying to be efficient, but just checking if they all agree *) - (* Note, if we wanted to do this for any term instead of just True/False - * we need to open the terms *) - | Tm_match {brs=br::brs} -> - let (_, _, e) = br in - let r = begin match simp_t e with - | None -> None - | Some b -> if List.for_all (fun (_, _, e') -> simp_t e' = Some b) brs - then Some b - else None - end - in - r - | _ -> None - in - let maybe_auto_squash t = - if U.is_sub_singleton t - then t - else U.mk_auto_squash U_zero t - in - let squashed_head_un_auto_squash_args t = - //The head of t is already a squashed operator, e.g. /\ etc. - //no point also squashing its arguments if they're already in U_zero - let maybe_un_auto_squash_arg (t,q) = - match U.is_auto_squash t with - | Some (U_zero, t) -> - //if we're squashing from U_zero to U_zero - // then just remove it - t, q - | _ -> - t,q - in - let head, args = U.head_and_args t in - let args = List.map maybe_un_auto_squash_arg args in - S.mk_Tm_app head args t.pos - in - let rec clearly_inhabited (ty : typ) : bool = - match (U.unmeta ty).n with - | Tm_uinst (t, _) -> clearly_inhabited t - | Tm_arrow {comp=c} -> clearly_inhabited (U.comp_result c) - | Tm_fvar fv -> - let l = S.lid_of_fv fv in - (Ident.lid_equals l PC.int_lid) - || (Ident.lid_equals l PC.bool_lid) - || (Ident.lid_equals l PC.string_lid) - || (Ident.lid_equals l PC.exn_lid) - | _ -> false - in - let simplify arg = (simp_t (fst arg), arg) in - match (SS.compress tm).n with - | Tm_app {hd={n=Tm_uinst({n=Tm_fvar fv}, _)}; args} - | Tm_app {hd={n=Tm_fvar fv}; args} -> - if S.fv_eq_lid fv PC.and_lid - then match args |> List.map simplify with - | [(Some true, _); (_, (arg, _))] - | [(_, (arg, _)); (Some true, _)] -> maybe_auto_squash arg - | [(Some false, _); _] - | [_; (Some false, _)] -> w U.t_false - | _ -> squashed_head_un_auto_squash_args tm - else if S.fv_eq_lid fv PC.or_lid - then match args |> List.map simplify with - | [(Some true, _); _] - | [_; (Some true, _)] -> w U.t_true - | [(Some false, _); (_, (arg, _))] - | [(_, (arg, _)); (Some false, _)] -> maybe_auto_squash arg - | _ -> squashed_head_un_auto_squash_args tm - else if S.fv_eq_lid fv PC.imp_lid - then match args |> List.map simplify with - | [_; (Some true, _)] - | [(Some false, _); _] -> w U.t_true - | [(Some true, _); (_, (arg, _))] -> maybe_auto_squash arg - | [(_, (p, _)); (_, (q, _))] -> - if U.term_eq p q - then w U.t_true - else squashed_head_un_auto_squash_args tm - | _ -> squashed_head_un_auto_squash_args tm - else if S.fv_eq_lid fv PC.iff_lid - then match args |> List.map simplify with - | [(Some true, _) ; (Some true, _)] - | [(Some false, _) ; (Some false, _)] -> w U.t_true - | [(Some true, _) ; (Some false, _)] - | [(Some false, _) ; (Some true, _)] -> w U.t_false - | [(_, (arg, _)) ; (Some true, _)] - | [(Some true, _) ; (_, (arg, _))] -> maybe_auto_squash arg - | [(_, (arg, _)) ; (Some false, _)] - | [(Some false, _) ; (_, (arg, _))] -> maybe_auto_squash (U.mk_neg arg) - | [(_, (p, _)); (_, (q, _))] -> - if U.term_eq p q - then w U.t_true - else squashed_head_un_auto_squash_args tm - | _ -> squashed_head_un_auto_squash_args tm - else if S.fv_eq_lid fv PC.not_lid - then match args |> List.map simplify with - | [(Some true, _)] -> w U.t_false - | [(Some false, _)] -> w U.t_true - | _ -> squashed_head_un_auto_squash_args tm - else if S.fv_eq_lid fv PC.forall_lid - then match args with - (* Simplify ∀x. True to True *) - | [(t, _)] -> - begin match (SS.compress t).n with - | Tm_abs {bs=[_]; body} -> - (match simp_t body with - | Some true -> w U.t_true - | _ -> tm) - | _ -> tm - end - (* Simplify ∀x. True to True, and ∀x. False to False, if the domain is not empty *) - | [(ty, Some ({ aqual_implicit = true })); (t, _)] -> - begin match (SS.compress t).n with - | Tm_abs {bs=[_]; body} -> - (match simp_t body with - | Some true -> w U.t_true - | Some false when clearly_inhabited ty -> w U.t_false - | _ -> tm) - | _ -> tm - end - | _ -> tm - else if S.fv_eq_lid fv PC.exists_lid - then match args with - (* Simplify ∃x. False to False *) - | [(t, _)] -> - begin match (SS.compress t).n with - | Tm_abs {bs=[_]; body} -> - (match simp_t body with - | Some false -> w U.t_false - | _ -> tm) - | _ -> tm - end - (* Simplify ∃x. False to False and ∃x. True to True, if the domain is not empty *) - | [(ty, Some ({ aqual_implicit = true })); (t, _)] -> - begin match (SS.compress t).n with - | Tm_abs {bs=[_]; body} -> - (match simp_t body with - | Some false -> w U.t_false - | Some true when clearly_inhabited ty -> w U.t_true - | _ -> tm) - | _ -> tm - end - | _ -> tm - else if S.fv_eq_lid fv PC.b2t_lid - then match args with - | [{n=Tm_constant (Const_bool true)}, _] -> w U.t_true - | [{n=Tm_constant (Const_bool false)}, _] -> w U.t_false - | _ -> tm //its arg is a bool, can't unsquash - else if S.fv_eq_lid fv PC.haseq_lid - then begin - (* - * AR: We try to mimic the hasEq related axioms in Prims - * and the axiom related to refinements - * For other types, such as lists, whose hasEq is derived by the typechecker, - * we leave them as is - *) - let t_has_eq_for_sure (t:S.term) :bool = - //Axioms from prims - let haseq_lids = [PC.int_lid; PC.bool_lid; PC.unit_lid; PC.string_lid] in - match (SS.compress t).n with - | Tm_fvar fv when haseq_lids |> List.existsb (fun l -> S.fv_eq_lid fv l) -> true - | _ -> false - in - if List.length args = 1 then - let t = args |> List.hd |> fst in - if t |> t_has_eq_for_sure then w U.t_true - else - match (SS.compress t).n with - | Tm_refine _ -> - let t = U.unrefine t in - if t |> t_has_eq_for_sure then w U.t_true - else - //get the hasEq term itself - let haseq_tm = - match (SS.compress tm).n with - | Tm_app {hd} -> hd - | _ -> failwith "Impossible! We have already checked that this is a Tm_app" - in - //and apply it to the unrefined type - mk_app (haseq_tm) [t |> as_arg] - | _ -> tm - else tm - end - else if S.fv_eq_lid fv PC.eq2_lid - then match args with - | [(_typ, _); (a1, _); (a2, _)] -> //eq2 - (match U.eq_tm a1 a2 with - | U.Equal -> w U.t_true - | U.NotEqual -> w U.t_false - | _ -> tm) - | _ -> tm - else - begin - match U.is_auto_squash tm with - | Some (U_zero, t) - when U.is_sub_singleton t -> - //remove redundant auto_squashes - t - | _ -> - tm - end - | Tm_refine {b=bv; phi=t} -> - begin match simp_t t with - | Some true -> bv.sort - | Some false -> tm - | None -> tm - end - | Tm_match _ -> - begin match is_const_match tm with - | Some true -> w U.t_true - | Some false -> w U.t_false - | None -> tm - end - | _ -> tm - let check_positivity_qual subtyping p0 p1 = if p0 = p1 then true else if subtyping diff --git a/src/typechecker/FStar.TypeChecker.Common.fsti b/src/typechecker/FStar.TypeChecker.Common.fsti index 8e91e651af0..aed6201f9d3 100644 --- a/src/typechecker/FStar.TypeChecker.Common.fsti +++ b/src/typechecker/FStar.TypeChecker.Common.fsti @@ -204,7 +204,6 @@ val residual_comp_of_lcomp : lcomp -> residual_comp val lcomp_of_comp_guard : comp -> guard_t -> lcomp //lcomp_of_comp_guard with trivial guard val lcomp_of_comp : comp -> lcomp -val simplify : debug:bool -> term -> term val check_positivity_qual (subtyping:bool) (p0 p1:option positivity_qualifier) : bool diff --git a/src/typechecker/FStar.TypeChecker.Core.fst b/src/typechecker/FStar.TypeChecker.Core.fst index c353707ad82..43b8280e479 100644 --- a/src/typechecker/FStar.TypeChecker.Core.fst +++ b/src/typechecker/FStar.TypeChecker.Core.fst @@ -16,6 +16,8 @@ module BU = FStar.Compiler.Util module TcUtil = FStar.TypeChecker.Util module Hash = FStar.Syntax.Hash module Subst = FStar.Syntax.Subst +module TEQ = FStar.TypeChecker.TermEqAndSimplify + open FStar.Class.Show open FStar.Class.Setlike @@ -1143,7 +1145,7 @@ and check_relation_comp (g:env) rel (c0 c1:comp) match destruct_comp c0, destruct_comp c1 with | None, _ | _, None -> - if U.eq_comp c0 c1 = U.Equal + if TEQ.eq_comp g.tcenv c0 c1 = TEQ.Equal then return () else ( let ct_eq res0 args0 res1 args1 = diff --git a/src/typechecker/FStar.TypeChecker.DMFF.fst b/src/typechecker/FStar.TypeChecker.DMFF.fst index 666f63a077a..5165430ac86 100644 --- a/src/typechecker/FStar.TypeChecker.DMFF.fst +++ b/src/typechecker/FStar.TypeChecker.DMFF.fst @@ -40,6 +40,7 @@ module TcTerm = FStar.TypeChecker.TcTerm module BU = FStar.Compiler.Util //basic util module U = FStar.Syntax.Util module PC = FStar.Parser.Const +module TEQ = FStar.TypeChecker.TermEqAndSimplify open FStar.Class.Setlike @@ -1298,7 +1299,7 @@ and trans_F_ (env: env_) (c: typ) (wp: term): term = failwith "mismatch"; mk (Tm_app {hd=head; args=List.map2 (fun (arg, q) (wp_arg, q') -> let print_implicit q = if S.is_aqual_implicit q then "implicit" else "explicit" in - if eq_aqual q q' <> Equal + if not (eq_aqual q q') then Errors.log_issue head.pos (Errors.Warning_IncoherentImplicitQualifier, diff --git a/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst b/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst index e3f04680c3b..35418a38c98 100644 --- a/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst +++ b/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst @@ -35,6 +35,7 @@ module BU = FStar.Compiler.Util module S = FStar.Syntax.Syntax module U = FStar.Syntax.Util module SS = FStar.Syntax.Subst +module TEQ = FStar.TypeChecker.TermEqAndSimplify open FStar.Class.Setlike @@ -115,7 +116,7 @@ let find_user_tac_for_uvar env (u:ctx_uvar) : option sigelt = (* candidates: hooks that also have the attribute [a] *) let candidates = hooks |> List.filter - (fun hook -> hook.sigattrs |> BU.for_some (U.attr_eq a)) + (fun hook -> hook.sigattrs |> BU.for_some (TEQ.eq_tm_bool env a)) in (* The environment sometimes returns duplicates in the candidate list; filter out dups *) let candidates = @@ -146,7 +147,7 @@ let find_user_tac_for_uvar env (u:ctx_uvar) : option sigelt = | Tm_fvar fv, [_; (a', _); (overrides, _)] //type argument may be missing, since it is just an attr | Tm_fvar fv, [(a', _); (overrides, _)] when fv_eq_lid fv FStar.Parser.Const.override_resolve_implicits_handler_lid - && U.attr_eq a a' -> + && TEQ.eq_tm_bool env a a' -> //other has an attribute [@@override_resolve_implicits_handler a overrides] begin match attr_list_elements overrides with diff --git a/src/typechecker/FStar.TypeChecker.NBE.fst b/src/typechecker/FStar.TypeChecker.NBE.fst index 2056e1d8061..8bcb2bc9cb6 100644 --- a/src/typechecker/FStar.TypeChecker.NBE.fst +++ b/src/typechecker/FStar.TypeChecker.NBE.fst @@ -45,6 +45,7 @@ module NU = FStar.TypeChecker.Normalize.Unfolding module FC = FStar.Const module EMB = FStar.Syntax.Embeddings module PC = FStar.Parser.Const +module TEQ = FStar.TypeChecker.TermEqAndSimplify open FStar.Class.Show @@ -1070,7 +1071,7 @@ and translate_monadic (m, ty) cfg bs e : t = S.mk (Tm_abs {bs=[S.mk_binder (BU.left lb.lbname)]; body; rc_opt=Some body_rc}) body.pos in let maybe_range_arg = - if BU.for_some (U.attr_eq U.dm4f_bind_range_attr) ed.eff_attrs + if BU.for_some (TEQ.eq_tm_bool cfg.core_cfg.tcenv U.dm4f_bind_range_attr) ed.eff_attrs then [translate cfg [] (PO.embed_simple lb.lbpos lb.lbpos), None; translate cfg [] (PO.embed_simple body.pos body.pos), None] else [] @@ -1289,7 +1290,7 @@ and readback (cfg:config) (x:t) : term = let refinement = U.refine x body in with_range ( if cfg.core_cfg.steps.simplify - then Common.simplify cfg.core_cfg.debug.wpe refinement + then TEQ.simplify cfg.core_cfg.debug.wpe cfg.core_cfg.tcenv refinement else refinement ) @@ -1326,7 +1327,7 @@ and readback (cfg:config) (x:t) : term = let app = U.mk_app (S.mk_Tm_uinst fv (List.rev us)) args in with_range ( if cfg.core_cfg.steps.simplify - then Common.simplify cfg.core_cfg.debug.wpe app + then TEQ.simplify cfg.core_cfg.debug.wpe cfg.core_cfg.tcenv app else app ) @@ -1338,7 +1339,7 @@ and readback (cfg:config) (x:t) : term = let app = U.mk_app (S.bv_to_name bv) args in with_range ( if cfg.core_cfg.steps.simplify - then Common.simplify cfg.core_cfg.debug.wpe app + then TEQ.simplify cfg.core_cfg.debug.wpe cfg.core_cfg.tcenv app else app ) @@ -1380,7 +1381,7 @@ and readback (cfg:config) (x:t) : term = let app = U.mk_app head args in with_range ( if cfg.core_cfg.steps.simplify - then Common.simplify cfg.core_cfg.debug.wpe app + then TEQ.simplify cfg.core_cfg.debug.wpe cfg.core_cfg.tcenv app else app ) diff --git a/src/typechecker/FStar.TypeChecker.NBETerm.fst b/src/typechecker/FStar.TypeChecker.NBETerm.fst index db10421a0b9..451f0879ac8 100644 --- a/src/typechecker/FStar.TypeChecker.NBETerm.fst +++ b/src/typechecker/FStar.TypeChecker.NBETerm.fst @@ -31,6 +31,8 @@ module P = FStar.Syntax.Print module BU = FStar.Compiler.Util module C = FStar.Const module SE = FStar.Syntax.Embeddings +module TEQ = FStar.TypeChecker.TermEqAndSimplify + open FStar.VConfig open FStar.Class.Show @@ -82,74 +84,74 @@ let mkAccuMatch (s:t) (ret:(unit -> option match_returns_ascription)) (bs:(unit // Term equality let equal_if = function - | true -> U.Equal - | _ -> U.Unknown + | true -> TEQ.Equal + | _ -> TEQ.Unknown let equal_iff = function - | true -> U.Equal - | _ -> U.NotEqual + | true -> TEQ.Equal + | _ -> TEQ.NotEqual let eq_inj r1 r2 = match r1, r2 with - | U.Equal, U.Equal -> U.Equal - | U.NotEqual, _ - | _, U.NotEqual -> U.NotEqual - | U.Unknown, _ - | _, U.Unknown -> U.Unknown + | TEQ.Equal, TEQ.Equal -> TEQ.Equal + | TEQ.NotEqual, _ + | _, TEQ.NotEqual -> TEQ.NotEqual + | TEQ.Unknown, _ + | _, TEQ.Unknown -> TEQ.Unknown let eq_and f g = match f with - | U.Equal -> g() - | _ -> U.Unknown + | TEQ.Equal -> g() + | _ -> TEQ.Unknown let eq_constant (c1 : constant) (c2 : constant) = match c1, c2 with -| Unit, Unit -> U.Equal +| Unit, Unit -> TEQ.Equal | Bool b1, Bool b2 -> equal_iff (b1 = b2) | Int i1, Int i2 -> equal_iff (i1 = i2) | String (s1, _), String (s2, _) -> equal_iff (s1 = s2) | Char c1, Char c2 -> equal_iff (c1 = c2) -| Range r1, Range r2 -> U.Unknown (* Seems that ranges are opaque *) -| _, _ -> U.NotEqual +| Range r1, Range r2 -> TEQ.Unknown (* Seems that ranges are opaque *) +| _, _ -> TEQ.NotEqual -let rec eq_t (t1 : t) (t2 : t) : U.eq_result = +let rec eq_t env (t1 : t) (t2 : t) : TEQ.eq_result = match t1.nbe_t, t2.nbe_t with - | Lam _, Lam _ -> U.Unknown - | Accu(a1, as1), Accu(a2, as2) -> eq_and (eq_atom a1 a2) (fun () -> eq_args as1 as2) + | Lam _, Lam _ -> TEQ.Unknown + | Accu(a1, as1), Accu(a2, as2) -> eq_and (eq_atom a1 a2) (fun () -> eq_args env as1 as2) | Construct(v1, us1, args1), Construct(v2, us2, args2) -> if S.fv_eq v1 v2 then begin if List.length args1 <> List.length args2 then failwith "eq_t, different number of args on Construct"; List.fold_left (fun acc ((a1, _), (a2, _)) -> - eq_inj acc (eq_t a1 a2)) U.Equal <| List.zip args1 args2 - end else U.NotEqual + eq_inj acc (eq_t env a1 a2)) TEQ.Equal <| List.zip args1 args2 + end else TEQ.NotEqual | FV(v1, us1, args1), FV(v2, us2, args2) -> if S.fv_eq v1 v2 then - eq_and (equal_iff (U.eq_univs_list us1 us2)) (fun () -> eq_args args1 args2) - else U.Unknown + eq_and (equal_iff (U.eq_univs_list us1 us2)) (fun () -> eq_args env args1 args2) + else TEQ.Unknown | Constant c1, Constant c2 -> eq_constant c1 c2 | Type_t u1, Type_t u2 | Univ u1, Univ u2 -> equal_iff (U.eq_univs u1 u2) | Refinement(r1, t1), Refinement(r2, t2) -> let x = S.new_bv None S.t_unit in (* bogus type *) - eq_and (eq_t (fst (t1 ())) (fst (t2 ()))) (fun () -> eq_t (r1 (mkAccuVar x)) (r2 (mkAccuVar x))) - | Unknown, Unknown -> U.Equal - | _, _ -> U.Unknown (* XXX following eq_tm *) + eq_and (eq_t env (fst (t1 ())) (fst (t2 ()))) (fun () -> eq_t env (r1 (mkAccuVar x)) (r2 (mkAccuVar x))) + | Unknown, Unknown -> TEQ.Equal + | _, _ -> TEQ.Unknown (* XXX following eq_tm *) -and eq_atom (a1 : atom) (a2 : atom) : U.eq_result = +and eq_atom (a1 : atom) (a2 : atom) : TEQ.eq_result = match a1, a2 with | Var bv1, Var bv2 -> equal_if (bv_eq bv1 bv2) (* ZP : TODO if or iff?? *) - | _, _ -> U.Unknown (* XXX Cannot compare suspended matches (?) *) - -and eq_arg (a1 : arg) (a2 : arg) = eq_t (fst a1) (fst a2) -and eq_args (as1 : args) (as2 : args) : U.eq_result = -match as1, as2 with -| [], [] -> U.Equal -| x :: xs, y :: ys -> eq_and (eq_arg x y) (fun () -> eq_args xs ys) -| _, _ -> U.Unknown (* ZP: following tm_eq, but why not U.NotEqual? *) + | _, _ -> TEQ.Unknown (* XXX Cannot compare suspended matches (?) *) + +and eq_arg env (a1 : arg) (a2 : arg) = eq_t env (fst a1) (fst a2) +and eq_args env (as1 : args) (as2 : args) : TEQ.eq_result = + match as1, as2 with + | [], [] -> TEQ.Equal + | x :: xs, y :: ys -> eq_and (eq_arg env x y) (fun () -> eq_args env xs ys) + | _, _ -> TEQ.Unknown (* ZP: following tm_eq, but why not TEQ.NotEqual? *) // Printing functions diff --git a/src/typechecker/FStar.TypeChecker.NBETerm.fsti b/src/typechecker/FStar.TypeChecker.NBETerm.fsti index 180ea8ebd23..0dbe63e90fa 100644 --- a/src/typechecker/FStar.TypeChecker.NBETerm.fsti +++ b/src/typechecker/FStar.TypeChecker.NBETerm.fsti @@ -29,7 +29,7 @@ open FStar.Char module S = FStar.Syntax.Syntax module U = FStar.Syntax.Util module Z = FStar.BigInt - +module TEQ = FStar.TypeChecker.TermEqAndSimplify open FStar.Class.Show val interleave_hack : int @@ -238,7 +238,7 @@ class embedding (a:Type0) = { e_typ : unit -> emb_typ; } -val eq_t : t -> t -> U.eq_result +val eq_t : Env.env_t -> t -> t -> TEQ.eq_result // Printing functions diff --git a/src/typechecker/FStar.TypeChecker.Normalize.Unfolding.fst b/src/typechecker/FStar.TypeChecker.Normalize.Unfolding.fst index 08c273bfbe0..ff4aa39686d 100644 --- a/src/typechecker/FStar.TypeChecker.Normalize.Unfolding.fst +++ b/src/typechecker/FStar.TypeChecker.Normalize.Unfolding.fst @@ -15,6 +15,8 @@ module PC = FStar.Parser.Const module Print = FStar.Syntax.Print module S = FStar.Syntax.Syntax module U = FStar.Syntax.Util +module TEQ = FStar.TypeChecker.TermEqAndSimplify + open FStar.Class.Show (* Max number of warnings to print in a single run. @@ -142,7 +144,7 @@ let should_unfold cfg should_reify fv qninfo : should_unfold_res = meets_some_criterion // UnfoldTac means never unfold FVs marked [@"tac_opaque"] - | _, _, _, _, _, _ when cfg.steps.unfold_tac && BU.for_some (U.attr_eq U.tac_opaque_attr) attrs -> + | _, _, _, _, _, _ when cfg.steps.unfold_tac && BU.for_some (TEQ.eq_tm_bool cfg.tcenv U.tac_opaque_attr) attrs -> log_unfolding cfg (fun () -> BU.print_string " >> tac_opaque, not unfolding\n"); no diff --git a/src/typechecker/FStar.TypeChecker.Normalize.fst b/src/typechecker/FStar.TypeChecker.Normalize.fst index 9986861e353..44d3c5d5070 100644 --- a/src/typechecker/FStar.TypeChecker.Normalize.fst +++ b/src/typechecker/FStar.TypeChecker.Normalize.fst @@ -48,7 +48,7 @@ module I = FStar.Ident module EMB = FStar.Syntax.Embeddings module Z = FStar.BigInt module TcComm = FStar.TypeChecker.Common - +module TEQ = FStar.TypeChecker.TermEqAndSimplify module PO = FStar.TypeChecker.Primops open FStar.TypeChecker.Normalize.Unfolding @@ -749,7 +749,7 @@ let reduce_primops norm_cb cfg env tm : term & bool = let reduce_equality norm_cb cfg tm = reduce_primops norm_cb ({cfg with steps = { default_steps with primops = true }; - primitive_steps=equality_ops}) tm + primitive_steps=equality_ops cfg.tcenv}) tm (********************************************************************************************************************) (* Main normalization function of the abstract machine *) @@ -1977,7 +1977,7 @@ and do_reify_monadic fallback cfg env stack (top : term) (m : monad_name) (t : t (S.as_arg lb.lbtyp)::(S.as_arg t)::(unit_args@range_args@[S.as_arg f_arg; S.as_arg body]) else let maybe_range_arg = - if BU.for_some (U.attr_eq U.dm4f_bind_range_attr) ed.eff_attrs + if BU.for_some (TEQ.eq_tm_bool cfg.tcenv U.dm4f_bind_range_attr) ed.eff_attrs then [as_arg (PO.embed_simple lb.lbpos lb.lbpos); as_arg (PO.embed_simple body.pos body.pos)] else [] diff --git a/src/typechecker/FStar.TypeChecker.Primops.Base.fsti b/src/typechecker/FStar.TypeChecker.Primops.Base.fsti index f8cc19d07dc..edac4fb7e8d 100644 --- a/src/typechecker/FStar.TypeChecker.Primops.Base.fsti +++ b/src/typechecker/FStar.TypeChecker.Primops.Base.fsti @@ -6,7 +6,7 @@ open FStar.Compiler open FStar.Compiler.Effect open FStar.Compiler.List open FStar.Syntax.Syntax - +module Env = FStar.TypeChecker.Env module EMB = FStar.Syntax.Embeddings module NBE = FStar.TypeChecker.NBETerm diff --git a/src/typechecker/FStar.TypeChecker.Primops.Eq.fst b/src/typechecker/FStar.TypeChecker.Primops.Eq.fst index cc3c0a2ac41..ce471a23881 100644 --- a/src/typechecker/FStar.TypeChecker.Primops.Eq.fst +++ b/src/typechecker/FStar.TypeChecker.Primops.Eq.fst @@ -14,63 +14,65 @@ module S = FStar.Syntax.Syntax module U = FStar.Syntax.Util module EMB = FStar.Syntax.Embeddings module NBE = FStar.TypeChecker.NBETerm +module TEQ = FStar.TypeChecker.TermEqAndSimplify +module Env = FStar.TypeChecker.Env open FStar.TypeChecker.Primops.Base -let s_eq (_typ x y : EMB.abstract_term) : option bool = - match U.eq_tm x.t y.t with - | U.Equal -> Some true - | U.NotEqual -> Some false +let s_eq (env:Env.env_t) (_typ x y : EMB.abstract_term) : option bool = + match TEQ.eq_tm env x.t y.t with + | TEQ.Equal -> Some true + | TEQ.NotEqual -> Some false | _ -> None -let nbe_eq (_typ x y : NBETerm.abstract_nbe_term) : option bool = - match NBETerm.eq_t x.t y.t with - | U.Equal -> Some true - | U.NotEqual -> Some false +let nbe_eq env (_typ x y : NBETerm.abstract_nbe_term) : option bool = + match NBETerm.eq_t env x.t y.t with + | TEQ.Equal -> Some true + | TEQ.NotEqual -> Some false | _ -> None let push3 f g x y z = f (g x y z) let negopt3 = push3 (fmap #option not) -let dec_eq_ops : list primitive_step = [ - mk3' 0 PC.op_Eq s_eq nbe_eq; - mk3' 0 PC.op_notEq (negopt3 s_eq) (negopt3 nbe_eq); +let dec_eq_ops env : list primitive_step = [ + mk3' 0 PC.op_Eq (s_eq env) (nbe_eq env); + mk3' 0 PC.op_notEq (negopt3 (s_eq env)) (negopt3 (nbe_eq env)); ] (* Propositional equality follows. We use the abstract newtypes to easily embed exactly the term we want. *) -let s_eq2 (_typ x y : EMB.abstract_term) : option EMB.abstract_term = - match U.eq_tm x.t y.t with - | U.Equal -> Some (EMB.Abstract U.t_true) - | U.NotEqual -> Some (EMB.Abstract U.t_false) +let s_eq2 env (_typ x y : EMB.abstract_term) : option EMB.abstract_term = + match TEQ.eq_tm env x.t y.t with + | TEQ.Equal -> Some (EMB.Abstract U.t_true) + | TEQ.NotEqual -> Some (EMB.Abstract U.t_false) | _ -> None -let nbe_eq2 (_typ x y : NBE.abstract_nbe_term) : option NBE.abstract_nbe_term = +let nbe_eq2 env (_typ x y : NBE.abstract_nbe_term) : option NBE.abstract_nbe_term = let open FStar.TypeChecker.NBETerm in - match NBETerm.eq_t x.t y.t with - | U.Equal -> Some (AbstractNBE (mkFV (S.lid_as_fv PC.true_lid None) [] [])) - | U.NotEqual -> Some (AbstractNBE (mkFV (S.lid_as_fv PC.false_lid None) [] [])) - | U.Unknown -> None + match NBETerm.eq_t env x.t y.t with + | TEQ.Equal -> Some (AbstractNBE (mkFV (S.lid_as_fv PC.true_lid None) [] [])) + | TEQ.NotEqual -> Some (AbstractNBE (mkFV (S.lid_as_fv PC.false_lid None) [] [])) + | TEQ.Unknown -> None -let s_eq3 (typ1 typ2 x y : EMB.abstract_term) : option EMB.abstract_term = - match U.eq_tm typ1.t typ2.t, U.eq_tm x.t y.t with - | U.Equal, U.Equal -> Some (EMB.Abstract U.t_true) - | U.NotEqual, _ - | _, U.NotEqual -> +let s_eq3 env (typ1 typ2 x y : EMB.abstract_term) : option EMB.abstract_term = + match TEQ.eq_tm env typ1.t typ2.t, TEQ.eq_tm env x.t y.t with + | TEQ.Equal, TEQ.Equal -> Some (EMB.Abstract U.t_true) + | TEQ.NotEqual, _ + | _, TEQ.NotEqual -> Some (EMB.Abstract U.t_false) | _ -> None -let nbe_eq3 (typ1 typ2 x y : NBE.abstract_nbe_term) : option NBE.abstract_nbe_term = +let nbe_eq3 env (typ1 typ2 x y : NBE.abstract_nbe_term) : option NBE.abstract_nbe_term = let open FStar.TypeChecker.NBETerm in - match eq_t typ1.t typ2.t, eq_t x.t y.t with - | U.Equal, U.Equal -> Some (AbstractNBE (mkFV (S.lid_as_fv PC.true_lid None) [] [])) - | U.NotEqual, _ - | _, U.NotEqual -> + match eq_t env typ1.t typ2.t, eq_t env x.t y.t with + | TEQ.Equal, TEQ.Equal -> Some (AbstractNBE (mkFV (S.lid_as_fv PC.true_lid None) [] [])) + | TEQ.NotEqual, _ + | _, TEQ.NotEqual -> Some (AbstractNBE (mkFV (S.lid_as_fv PC.false_lid None) [] [])) | _ -> None -let prop_eq_ops : list primitive_step = [ - mk3' 1 PC.eq2_lid s_eq2 nbe_eq2; - mk4' 2 PC.eq3_lid s_eq3 nbe_eq3; +let prop_eq_ops env : list primitive_step = [ + mk3' 1 PC.eq2_lid (s_eq2 env) (nbe_eq2 env); + mk4' 2 PC.eq3_lid (s_eq3 env) (nbe_eq3 env); ] diff --git a/src/typechecker/FStar.TypeChecker.Primops.Eq.fsti b/src/typechecker/FStar.TypeChecker.Primops.Eq.fsti index 7dd929e8ac8..c884d7c6a02 100644 --- a/src/typechecker/FStar.TypeChecker.Primops.Eq.fsti +++ b/src/typechecker/FStar.TypeChecker.Primops.Eq.fsti @@ -1,7 +1,7 @@ module FStar.TypeChecker.Primops.Eq - +module Env = FStar.TypeChecker.Env open FStar.TypeChecker.Primops.Base -val dec_eq_ops : list primitive_step +val dec_eq_ops (_:Env.env_t) : list primitive_step -val prop_eq_ops : list primitive_step \ No newline at end of file +val prop_eq_ops (_:Env.env_t) : list primitive_step \ No newline at end of file diff --git a/src/typechecker/FStar.TypeChecker.Primops.fst b/src/typechecker/FStar.TypeChecker.Primops.fst index e19e2e18fe7..ce52eb5fc71 100644 --- a/src/typechecker/FStar.TypeChecker.Primops.fst +++ b/src/typechecker/FStar.TypeChecker.Primops.fst @@ -400,8 +400,9 @@ let built_in_primitive_steps_list : list primitive_step = @ Primops.Erased.ops @ Primops.Docs.ops @ Primops.MachineInts.ops - @ Primops.Eq.dec_eq_ops @ Primops.Errors.Msg.ops -let equality_ops_list : list primitive_step = - Primops.Eq.prop_eq_ops +let equality_ops_list env : list primitive_step = + Primops.Eq.prop_eq_ops env + +let env_dependent_ops (env:Env.env_t) = Primops.Eq.dec_eq_ops env \ No newline at end of file diff --git a/src/typechecker/FStar.TypeChecker.Primops.fsti b/src/typechecker/FStar.TypeChecker.Primops.fsti index 455dc428ba7..39cca74551f 100644 --- a/src/typechecker/FStar.TypeChecker.Primops.fsti +++ b/src/typechecker/FStar.TypeChecker.Primops.fsti @@ -6,4 +6,5 @@ include FStar.TypeChecker.Primops.Base with their implementations. *) val built_in_primitive_steps_list : list primitive_step -val equality_ops_list : list primitive_step +val equality_ops_list (env:Env.env_t) : list primitive_step +val env_dependent_ops (env:Env.env_t) : list primitive_step \ No newline at end of file diff --git a/src/typechecker/FStar.TypeChecker.Rel.fst b/src/typechecker/FStar.TypeChecker.Rel.fst index a95b34d944d..ccddd804b32 100644 --- a/src/typechecker/FStar.TypeChecker.Rel.fst +++ b/src/typechecker/FStar.TypeChecker.Rel.fst @@ -50,6 +50,7 @@ module UF = FStar.Syntax.Unionfind module PC = FStar.Parser.Const module FC = FStar.Const module TcComm = FStar.TypeChecker.Common +module TEQ = FStar.TypeChecker.TermEqAndSimplify instance showable_implicit_checking_status : showable implicit_checking_status = { show = (function @@ -1367,7 +1368,7 @@ let head_matches_delta env smt_ok t1 t2 : (match_result & option (typ&typ)) = //should we always disable Zeta here? in let t' = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.1" steps env t in - if U.eq_tm t t' = U.Equal //if we didn't inline anything + if TEQ.eq_tm env t t' = TEQ.Equal //if we didn't inline anything then None else let _ = if Env.debug env <| Options.Other "RelDelta" then BU.print2 "Inlined %s to %s\n" @@ -1390,7 +1391,7 @@ let head_matches_delta env smt_ok t1 t2 : (match_result & option (typ&typ)) = *) let made_progress t t' = let head, head' = U.head_and_args t |> fst, U.head_and_args t' |> fst in - not (U.eq_tm head head' = U.Equal) in + not (TEQ.eq_tm env head head' = TEQ.Equal) in let rec aux retry n_delta t1 t2 = let r = head_matches env t1 t2 in @@ -2687,7 +2688,7 @@ and solve_binders (bs1:binders) (bs2:binders) (orig:prob) (wl:worklist) let eq_bqual a1 a2 = match a1, a2 with | Some (Implicit b1), Some (Implicit b2) -> - U.Equal //we don't care about comparing the dot qualifier in this context + true //we don't care about comparing the dot qualifier in this context | _ -> U.eq_bqual a1 a2 in @@ -2723,7 +2724,7 @@ and solve_binders (bs1:binders) (bs2:binders) (orig:prob) (wl:worklist) Inl ([rhs_prob], formula), wl | x::xs, y::ys - when (eq_bqual x.binder_qual y.binder_qual = U.Equal && + when (eq_bqual x.binder_qual y.binder_qual && compat_positivity_qualifiers x.binder_positivity y.binder_positivity) -> let hd1, imp = x.binder_bv, x.binder_qual in let hd2, imp' = y.binder_bv, y.binder_qual in @@ -2858,7 +2859,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) | None, None -> true | Some (Implicit _), Some a -> a.aqual_implicit && - U.eqlist (fun x y -> U.eq_tm x y = U.Equal) + U.eqlist (fun x y -> TEQ.eq_tm env x y = TEQ.Equal) b.binder_attrs a.aqual_attributes | _ -> false @@ -3175,7 +3176,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) UF.rollback tx; inapplicable "Subprobs failed: " (Some lstring) in - if U.eq_tm t_head (U.ctx_uvar_typ ctx_uv) = U.Equal + if TEQ.eq_tm env t_head (U.ctx_uvar_typ ctx_uv) = TEQ.Equal then // // eq_tm doesn't unify, so uvars_head computed remains consistent @@ -3443,7 +3444,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = (show head1) (show args1) (show head2) (show args2))) orig else - if nargs=0 || U.eq_args args1 args2=U.Equal //special case: for easily proving things like nat <: nat, or greater_than i <: greater_than i etc. + if nargs=0 || TEQ.eq_args env args1 args2=TEQ.Equal //special case: for easily proving things like nat <: nat, or greater_than i <: greater_than i etc. then if need_unif then solve_t ({problem with lhs=head1; rhs=head2}) wl else solve_head_then wl (fun ok wl -> @@ -3515,8 +3516,8 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = let head1', _ = U.head_and_args t1' in let head2', _ = U.head_and_args t2' in begin - match U.eq_tm head1' head1, U.eq_tm head2' head2 with - | U.Equal, U.Equal -> //unfolding didn't make progress + match TEQ.eq_tm env head1' head1, TEQ.eq_tm env head2' head2 with + | TEQ.Equal, TEQ.Equal -> //unfolding didn't make progress if debug wl <| Options.Other "Rel" then BU.print4 "Unfolding didn't make progress ... got %s ~> %s;\nand %s ~> %s\n" @@ -4240,21 +4241,21 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = let equal t1 t2 : bool = (* Try comparing the terms as they are. If we get Equal or NotEqual, we are done. If we get an Unknown, attempt some normalization. *) - let r = U.eq_tm t1 t2 in + let env = p_env wl orig in + let r = TEQ.eq_tm env t1 t2 in match r with - | U.Equal -> true - | U.NotEqual -> false - | U.Unknown -> + | TEQ.Equal -> true + | TEQ.NotEqual -> false + | TEQ.Unknown -> let steps = [ Env.UnfoldUntil delta_constant; Env.Primops; Env.Beta; Env.Eager_unfolding; Env.Iota ] in - let env = p_env wl orig in let t1 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps env t1 in let t2 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t2 in - U.eq_tm t1 t2 = U.Equal + TEQ.eq_tm env t1 t2 = TEQ.Equal in if (Env.is_interpreted wl.tcenv head1 || Env.is_interpreted wl.tcenv head2) //we have something like (+ x1 x2) =?= (- y1 y2) && problem.relation = EQ diff --git a/src/typechecker/FStar.TypeChecker.TcEffect.fst b/src/typechecker/FStar.TypeChecker.TcEffect.fst index 39299526b31..b9b0ddfd03b 100644 --- a/src/typechecker/FStar.TypeChecker.TcEffect.fst +++ b/src/typechecker/FStar.TypeChecker.TcEffect.fst @@ -38,6 +38,7 @@ module Env = FStar.TypeChecker.Env module N = FStar.TypeChecker.Normalize module TcUtil = FStar.TypeChecker.Util module Gen = FStar.TypeChecker.Generalize +module TEQ = FStar.TypeChecker.TermEqAndSimplify module BU = FStar.Compiler.Util open FStar.Class.Show @@ -254,9 +255,9 @@ let bind_combinator_kind (env:env) U.arrow [S.mk_binder x_bv] (mk_Total g_sig_b_sort) in let g_b_kind = - if U.eq_tm g_sig_b_arrow_t g_b.binder_bv.sort = U.Equal + if TEQ.eq_tm env g_sig_b_arrow_t g_b.binder_bv.sort = TEQ.Equal then Substitutive_binder - else if U.eq_tm g_sig_b_sort g_b.binder_bv.sort = U.Equal + else if TEQ.eq_tm env g_sig_b_sort g_b.binder_bv.sort = TEQ.Equal then BindCont_no_abstraction_binder else Ad_hoc_binder in let ss = ss@[NT (g_sig_b.binder_bv, g_b.binder_bv |> S.bv_to_name)] in @@ -301,7 +302,7 @@ let bind_combinator_kind (env:env) result_typ = a_b.binder_bv |> S.bv_to_name; effect_args = repr_app_bs |> List.map (fun b -> b.binder_bv |> S.bv_to_name |> S.as_arg); flags = []})) in - if U.eq_tm f_b.binder_bv.sort expected_f_b_sort = U.Equal + if TEQ.eq_tm env f_b.binder_bv.sort expected_f_b_sort = TEQ.Equal then Some () else None in @@ -335,7 +336,7 @@ let bind_combinator_kind (env:env) effect_args = repr_args; flags = []})) in U.arrow [x_bv |> S.mk_binder] (mk_Total thunk_t) in - if U.eq_tm g_b.binder_bv.sort expected_g_b_sort = U.Equal + if TEQ.eq_tm env g_b.binder_bv.sort expected_g_b_sort = TEQ.Equal then Some () else None in @@ -579,7 +580,7 @@ let subcomp_combinator_kind (env:env) result_typ = a_b.binder_bv |> S.bv_to_name; effect_args = (eff_params_bs@f_bs) |> List.map (fun b -> b.binder_bv |> S.bv_to_name |> S.as_arg); flags = []})) in - if U.eq_tm f_b.binder_bv.sort expected_f_b_sort = U.Equal + if TEQ.eq_tm env f_b.binder_bv.sort expected_f_b_sort = TEQ.Equal then Some () else None in @@ -600,7 +601,7 @@ let subcomp_combinator_kind (env:env) result_typ = a_b.binder_bv |> S.bv_to_name; effect_args = (eff_params_bs@f_or_g_bs) |> List.map (fun b -> b.binder_bv |> S.bv_to_name |> S.as_arg); flags = []})) in - if U.eq_tm (U.comp_result k_c) expected_t = U.Equal + if TEQ.eq_tm env (U.comp_result k_c) expected_t = TEQ.Equal then Some () else None in @@ -810,7 +811,7 @@ let ite_combinator_kind (env:env) ((a_b.binder_bv |> S.bv_to_name |> S.as_arg):: (List.map (fun {binder_bv=b} -> b |> S.bv_to_name |> S.as_arg) (eff_params_bs@f_bs))) Range.dummyRange in - if U.eq_tm f_b.binder_bv.sort expected_f_b_sort = U.Equal + if TEQ.eq_tm env f_b.binder_bv.sort expected_f_b_sort = TEQ.Equal then Some () else None in @@ -821,7 +822,7 @@ let ite_combinator_kind (env:env) ((a_b.binder_bv |> S.bv_to_name |> S.as_arg):: (List.map (fun {binder_bv=b} -> b |> S.bv_to_name |> S.as_arg) (eff_params_bs@f_or_g_bs))) Range.dummyRange in - if U.eq_tm g_b.binder_bv.sort expected_g_b_sort = U.Equal + if TEQ.eq_tm env g_b.binder_bv.sort expected_g_b_sort = TEQ.Equal then Some () else None in @@ -1078,7 +1079,7 @@ let lift_combinator_kind (env:env) result_typ = a_b.binder_bv |> S.bv_to_name; effect_args = f_bs |> List.map (fun b -> b.binder_bv |> S.bv_to_name |> S.as_arg); flags = []})) in - if U.eq_tm f_b.binder_bv.sort expected_f_b_sort = U.Equal + if TEQ.eq_tm env f_b.binder_bv.sort expected_f_b_sort = TEQ.Equal then Some () else None in @@ -2221,7 +2222,7 @@ Errors.with_ctx (BU.format1 "While checking effect definition `%s`" (string_of_l mk_repr b wp in let maybe_range_arg = - if BU.for_some (U.attr_eq U.dm4f_bind_range_attr) ed.eff_attrs + if BU.for_some (TEQ.eq_tm_bool env U.dm4f_bind_range_attr) ed.eff_attrs then [S.null_binder S.t_range; S.null_binder S.t_range] else [] in diff --git a/src/typechecker/FStar.TypeChecker.TcTerm.fst b/src/typechecker/FStar.TypeChecker.TcTerm.fst index 53f9584497e..9f59ce15063 100644 --- a/src/typechecker/FStar.TypeChecker.TcTerm.fst +++ b/src/typechecker/FStar.TypeChecker.TcTerm.fst @@ -49,6 +49,7 @@ module U = FStar.Syntax.Util module PP = FStar.Syntax.Print module UF = FStar.Syntax.Unionfind module Const = FStar.Parser.Const +module TEQ = FStar.TypeChecker.TermEqAndSimplify (* Some local utilities *) let instantiate_both env = {env with Env.instantiate_imp=true} @@ -555,7 +556,7 @@ let guard_letrecs env actuals expected_c : list (lbname*typ*univ_names) = let t1 = env.typeof_well_typed_tot_or_gtot_term env e1 false |> fst |> U.unrefine in let t2 = env.typeof_well_typed_tot_or_gtot_term env e2 false |> fst |> U.unrefine in let rec warn t1 t2 = - if U.eq_tm t1 t2 = Equal + if TEQ.eq_tm env t1 t2 = TEQ.Equal then false else match (SS.compress t1).n, (SS.compress t2).n with | Tm_uinst (t1, _), Tm_uinst (t2, _) -> warn t1 t2 @@ -619,7 +620,7 @@ let guard_letrecs env actuals expected_c : list (lbname*typ*univ_names) = * just prove that (rel e e_prev) *) let rel_guard = mk_Tm_app rel [as_arg e; as_arg e_prev] r in - if U.eq_tm rel rel_prev = U.Equal + if TEQ.eq_tm env rel rel_prev = TEQ.Equal then rel_guard else ( (* if the relation is dependent on parameters in scope, @@ -2153,7 +2154,7 @@ and tc_abs_check_binders env bs bs_expected use_eq | Some (Implicit _), Some (Meta _) -> true | _ -> false in - if not (special imp imp') && U.eq_bqual imp imp' <> U.Equal + if not (special imp imp') && not (U.eq_bqual imp imp') then raise_error (Errors.Fatal_InconsistentImplicitArgumentAnnotation, BU.format1 "Inconsistent implicit argument annotation on argument %s" (Print.bv_to_string hd)) (S.range_of_bv hd) @@ -2214,7 +2215,7 @@ and tc_abs_check_binders env bs bs_expected use_eq let hd = {hd with sort=t} in let combine_attrs (attrs:list S.attribute) (attrs':list S.attribute) : list S.attribute = let diff = List.filter (fun attr' -> - not (List.existsb (fun attr -> U.eq_tm attr attr' = U.Equal) attrs) + not (List.existsb (fun attr -> TEQ.eq_tm env attr attr' = TEQ.Equal) attrs) ) attrs' in attrs@diff in diff --git a/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst b/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst new file mode 100644 index 00000000000..c92b131b4a7 --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst @@ -0,0 +1,531 @@ +module FStar.TypeChecker.TermEqAndSimplify +open FStar.Pervasives +open FStar.Compiler.Effect +open FStar.Compiler +open FStar.Compiler.Util +open FStar.Syntax +open FStar.Const +open FStar.Ident +open FStar.TypeChecker.Env +open FStar.Syntax.Syntax +open FStar.Syntax.Util +module SS = FStar.Syntax.Subst +module U = FStar.Syntax.Util +module PC = FStar.Parser.Const +module S = FStar.Syntax.Syntax +module BU = FStar.Compiler.Util + +// Functions that we specially treat as injective, to make normalization +// (particularly of decidable equality) better. We should make sure they +// are actually proved to be injective. +let injectives = + ["FStar.Int8.int_to_t"; + "FStar.Int16.int_to_t"; + "FStar.Int32.int_to_t"; + "FStar.Int64.int_to_t"; + "FStar.Int128.int_to_t"; + "FStar.UInt8.uint_to_t"; + "FStar.UInt16.uint_to_t"; + "FStar.UInt32.uint_to_t"; + "FStar.UInt64.uint_to_t"; + "FStar.UInt128.uint_to_t"; + "FStar.SizeT.uint_to_t"; + "FStar.Int8.__int_to_t"; + "FStar.Int16.__int_to_t"; + "FStar.Int32.__int_to_t"; + "FStar.Int64.__int_to_t"; + "FStar.Int128.__int_to_t"; + "FStar.UInt8.__uint_to_t"; + "FStar.UInt16.__uint_to_t"; + "FStar.UInt32.__uint_to_t"; + "FStar.UInt64.__uint_to_t"; + "FStar.UInt128.__uint_to_t"; + "FStar.SizeT.__uint_to_t"; + ] + +// Compose two eq_result injectively, as in a pair +let eq_inj r s = + match r, s with + | Equal, Equal -> Equal + | NotEqual, _ + | _, NotEqual -> NotEqual + | _, _ -> Unknown + +// Promote a bool to eq_result, conservatively. +let equal_if = function + | true -> Equal + | _ -> Unknown + +// Promote a bool to an eq_result, taking a false to bet NotEqual. +// This is only useful for fully decidable equalities. +// Use with care, see note about Const_real below and #2806. +let equal_iff = function + | true -> Equal + | _ -> NotEqual + +// Compose two equality results, NOT assuming a NotEqual implies anything. +// This is useful, e.g., for checking the equality of applications. Consider +// f x ~ g y +// if f=g and x=y then we know these two expressions are equal, but cannot say +// anything when either result is NotEqual or Unknown, hence this returns Unknown +// in most cases. +// The second comparison is thunked for efficiency. +let eq_and r s = + if r = Equal && s () = Equal + then Equal + else Unknown + +(* Precondition: terms are well-typed in a common environment, or this can return false positives *) +let rec eq_tm (env:env_t) (t1:term) (t2:term) : eq_result = + let eq_tm = eq_tm env in + let t1 = canon_app t1 in + let t2 = canon_app t2 in + let equal_data (f1:fv) (args1:Syntax.args) (f2:fv) (args2:Syntax.args) = + // we got constructors! we know they are injective and disjoint, so we can do some + // good analysis on them + if fv_eq f1 f2 + then ( + assert (List.length args1 = List.length args2); + List.fold_left (fun acc ((a1, q1), (a2, q2)) -> + //if q1 <> q2 + //then failwith (U.format1 "Arguments of %s mismatch on implicit qualifier\n" + // (Ident.string_of_lid f1.fv_name.v)); + //NS: 05/06/2018 ...this does not always hold + // it's been succeeding because the assert is disabled in the non-debug builds + //assert (q1 = q2); + eq_inj acc (eq_tm a1 a2)) Equal <| List.zip args1 args2 + ) else NotEqual + in + let qual_is_inj = function + | Some Data_ctor + | Some (Record_ctor _) -> true + | _ -> false + in + let heads_and_args_in_case_both_data :option (fv * args * fv * args) = + let head1, args1 = t1 |> unmeta |> head_and_args in + let head2, args2 = t2 |> unmeta |> head_and_args in + match (un_uinst head1).n, (un_uinst head2).n with + | Tm_fvar f, Tm_fvar g when qual_is_inj f.fv_qual && + qual_is_inj g.fv_qual -> Some (f, args1, g, args2) + | _ -> None + in + let t1 = unmeta t1 in + let t2 = unmeta t2 in + match t1.n, t2.n with + // We sometimes compare open terms, as we get alpha-equivalence + // for free. + | Tm_bvar bv1, Tm_bvar bv2 -> + equal_if (bv1.index = bv2.index) + + | Tm_lazy _, _ -> eq_tm (unlazy t1) t2 + | _, Tm_lazy _ -> eq_tm t1 (unlazy t2) + + | Tm_name a, Tm_name b -> + equal_if (bv_eq a b) + + | _ when heads_and_args_in_case_both_data |> Some? -> //matches only when both are data constructors + heads_and_args_in_case_both_data |> must |> (fun (f, args1, g, args2) -> + equal_data f args1 g args2 + ) + + | Tm_fvar f, Tm_fvar g -> equal_if (fv_eq f g) + + | Tm_uinst(f, us), Tm_uinst(g, vs) -> + // If the fvars and universe instantiations match, then Equal, + // otherwise Unknown. + eq_and (eq_tm f g) (fun () -> equal_if (eq_univs_list us vs)) + + | Tm_constant (Const_range _), Tm_constant (Const_range _) -> + // Ranges should be opaque, even to the normalizer. c.f. #1312 + Unknown + + | Tm_constant (Const_real r1), Tm_constant (Const_real r2) -> + // We cannot decide equality of reals. Use a conservative approach here. + // If the strings match, they are equal, otherwise we don't know. If this + // goes via the eq_iff case below, it will falsely claim that "1.0R" and + // "01.R" are different, since eq_const does not canonizalize the string + // representations. + equal_if (r1 = r2) + + | Tm_constant c, Tm_constant d -> + // NOTE: this relies on the fact that eq_const *correctly decides* + // semantic equality of constants. This needs some care. For instance, + // since integers are represented by a string, eq_const needs to take care + // of ignoring leading zeroes, and match 0 with -0. An exception to this + // are real number literals (handled above). See #2806. + // + // Currently (24/Jan/23) this seems to be correctly implemented, but + // updates should be done with care. + equal_iff (eq_const c d) + + | Tm_uvar (u1, ([], _)), Tm_uvar (u2, ([], _)) -> + equal_if (Unionfind.equiv u1.ctx_uvar_head u2.ctx_uvar_head) + + | Tm_app {hd=h1; args=args1}, Tm_app {hd=h2; args=args2} -> + begin match (un_uinst h1).n, (un_uinst h2).n with + | Tm_fvar f1, Tm_fvar f2 when fv_eq f1 f2 && List.mem (string_of_lid (lid_of_fv f1)) injectives -> + equal_data f1 args1 f2 args2 + + | _ -> // can only assert they're equal if they syntactically match, nothing else + eq_and (eq_tm h1 h2) (fun () -> eq_args env args1 args2) + end + + | Tm_match {scrutinee=t1; brs=bs1}, Tm_match {scrutinee=t2; brs=bs2} -> //AR: note: no return annotations + if List.length bs1 = List.length bs2 + then List.fold_right (fun (b1, b2) a -> eq_and a (fun () -> branch_matches env b1 b2)) + (List.zip bs1 bs2) + (eq_tm t1 t2) + else Unknown + + | Tm_type u, Tm_type v -> + equal_if (eq_univs u v) + + | Tm_quoted (t1, q1), Tm_quoted (t2, q2) -> + // NOTE: we do NOT ever provide a meaningful result for quoted terms. Even + // if term_eq (the syntactic equality) returns true, that does not mean we + // can present the equality to userspace since term_eq ignores the names + // of binders, but the view exposes them. Hence, we simply always return + // Unknown. We do not seem to rely anywhere on simplifying equalities of + // quoted literals. See also #2806. + Unknown + + | Tm_refine {b=t1; phi=phi1}, Tm_refine {b=t2; phi=phi2} -> + eq_and (eq_tm t1.sort t2.sort) (fun () -> eq_tm phi1 phi2) + + (* + * AR: ignoring residual comp here, that's an ascription added by the typechecker + * do we care if that's different? + *) + | Tm_abs {bs=bs1; body=body1}, Tm_abs {bs=bs2; body=body2} + when List.length bs1 = List.length bs2 -> + + eq_and (List.fold_left2 (fun r b1 b2 -> eq_and r (fun () -> eq_tm b1.binder_bv.sort b2.binder_bv.sort)) + Equal bs1 bs2) + (fun () -> eq_tm body1 body2) + + | Tm_arrow {bs=bs1; comp=c1}, Tm_arrow {bs=bs2; comp=c2} + when List.length bs1 = List.length bs2 -> + eq_and (List.fold_left2 (fun r b1 b2 -> eq_and r (fun () -> eq_tm b1.binder_bv.sort b2.binder_bv.sort)) + Equal bs1 bs2) + (fun () -> eq_comp env c1 c2) + + | _ -> Unknown + +and eq_antiquotations (env:env_t) a1 a2 = + // Basically this; + // List.fold_left2 (fun acc t1 t2 -> eq_inj acc (eq_tm t1 t2)) Equal a1 a2 + // but lazy and handling lists of different size + match a1, a2 with + | [], [] -> Equal + | [], _ + | _, [] -> NotEqual + | t1::a1, t2::a2 -> + match eq_tm env t1 t2 with + | NotEqual -> NotEqual + | Unknown -> + (match eq_antiquotations env a1 a2 with + | NotEqual -> NotEqual + | _ -> Unknown) + | Equal -> eq_antiquotations env a1 a2 + +and branch_matches env b1 b2 = + let related_by f o1 o2 = + match o1, o2 with + | None, None -> true + | Some x, Some y -> f x y + | _, _ -> false + in + let (p1, w1, t1) = b1 in + let (p2, w2, t2) = b2 in + if eq_pat p1 p2 + then begin + // We check the `when` branches too, even if unsupported for now + if eq_tm env t1 t2 = Equal && related_by (fun t1 t2 -> eq_tm env t1 t2 = Equal) w1 w2 + then Equal + else Unknown + end + else Unknown + +and eq_args env (a1:args) (a2:args) : eq_result = + match a1, a2 with + | [], [] -> Equal + | (a, _)::a1, (b, _)::b1 -> + (match eq_tm env a b with + | Equal -> eq_args env a1 b1 + | _ -> Unknown) + | _ -> Unknown + +and eq_comp env (c1 c2:comp) : eq_result = + match c1.n, c2.n with + | Total t1, Total t2 + | GTotal t1, GTotal t2 -> + eq_tm env t1 t2 + | Comp ct1, Comp ct2 -> + eq_and (equal_if (eq_univs_list ct1.comp_univs ct2.comp_univs)) + (fun _ -> + eq_and (equal_if (Ident.lid_equals ct1.effect_name ct2.effect_name)) + (fun _ -> + eq_and (eq_tm env ct1.result_typ ct2.result_typ) + (fun _ -> eq_args env ct1.effect_args ct2.effect_args))) + //ignoring cflags + | _ -> NotEqual + +let eq_tm_bool e t1 t2 = eq_tm e t1 t2 = Equal + +let simplify (debug:bool) (env:env_t) (tm:term) : term = + let w t = {t with pos=tm.pos} in + let simp_t t = + // catch annotated subformulae too + match (U.unmeta t).n with + | Tm_fvar fv when S.fv_eq_lid fv PC.true_lid -> Some true + | Tm_fvar fv when S.fv_eq_lid fv PC.false_lid -> Some false + | _ -> None + in + let rec args_are_binders args bs = + match args, bs with + | (t, _)::args, b::bs -> + begin match (SS.compress t).n with + | Tm_name bv' -> S.bv_eq b.binder_bv bv' && args_are_binders args bs + | _ -> false + end + | [], [] -> true + | _, _ -> false + in + let is_applied (bs:binders) (t : term) : option bv = + if debug then + BU.print2 "WPE> is_applied %s -- %s\n" (Print.term_to_string t) (Print.tag_of_term t); + let hd, args = U.head_and_args_full t in + match (SS.compress hd).n with + | Tm_name bv when args_are_binders args bs -> + if debug then + BU.print3 "WPE> got it\n>>>>top = %s\n>>>>b = %s\n>>>>hd = %s\n" + (Print.term_to_string t) + (Print.bv_to_string bv) + (Print.term_to_string hd); + Some bv + | _ -> None + in + let is_applied_maybe_squashed (bs : binders) (t : term) : option bv = + if debug then + BU.print2 "WPE> is_applied_maybe_squashed %s -- %s\n" (Print.term_to_string t) (Print.tag_of_term t); + match is_squash t with + + | Some (_, t') -> is_applied bs t' + | _ -> begin match is_auto_squash t with + | Some (_, t') -> is_applied bs t' + | _ -> is_applied bs t + end + in + let is_const_match (phi : term) : option bool = + match (SS.compress phi).n with + (* Trying to be efficient, but just checking if they all agree *) + (* Note, if we wanted to do this for any term instead of just True/False + * we need to open the terms *) + | Tm_match {brs=br::brs} -> + let (_, _, e) = br in + let r = begin match simp_t e with + | None -> None + | Some b -> if List.for_all (fun (_, _, e') -> simp_t e' = Some b) brs + then Some b + else None + end + in + r + | _ -> None + in + let maybe_auto_squash t = + if U.is_sub_singleton t + then t + else U.mk_auto_squash U_zero t + in + let squashed_head_un_auto_squash_args t = + //The head of t is already a squashed operator, e.g. /\ etc. + //no point also squashing its arguments if they're already in U_zero + let maybe_un_auto_squash_arg (t,q) = + match U.is_auto_squash t with + | Some (U_zero, t) -> + //if we're squashing from U_zero to U_zero + // then just remove it + t, q + | _ -> + t,q + in + let head, args = U.head_and_args t in + let args = List.map maybe_un_auto_squash_arg args in + S.mk_Tm_app head args t.pos + in + let rec clearly_inhabited (ty : typ) : bool = + match (U.unmeta ty).n with + | Tm_uinst (t, _) -> clearly_inhabited t + | Tm_arrow {comp=c} -> clearly_inhabited (U.comp_result c) + | Tm_fvar fv -> + let l = S.lid_of_fv fv in + (Ident.lid_equals l PC.int_lid) + || (Ident.lid_equals l PC.bool_lid) + || (Ident.lid_equals l PC.string_lid) + || (Ident.lid_equals l PC.exn_lid) + | _ -> false + in + let simplify arg = (simp_t (fst arg), arg) in + match (SS.compress tm).n with + | Tm_app {hd={n=Tm_uinst({n=Tm_fvar fv}, _)}; args} + | Tm_app {hd={n=Tm_fvar fv}; args} -> + if S.fv_eq_lid fv PC.and_lid + then match args |> List.map simplify with + | [(Some true, _); (_, (arg, _))] + | [(_, (arg, _)); (Some true, _)] -> maybe_auto_squash arg + | [(Some false, _); _] + | [_; (Some false, _)] -> w U.t_false + | _ -> squashed_head_un_auto_squash_args tm + else if S.fv_eq_lid fv PC.or_lid + then match args |> List.map simplify with + | [(Some true, _); _] + | [_; (Some true, _)] -> w U.t_true + | [(Some false, _); (_, (arg, _))] + | [(_, (arg, _)); (Some false, _)] -> maybe_auto_squash arg + | _ -> squashed_head_un_auto_squash_args tm + else if S.fv_eq_lid fv PC.imp_lid + then match args |> List.map simplify with + | [_; (Some true, _)] + | [(Some false, _); _] -> w U.t_true + | [(Some true, _); (_, (arg, _))] -> maybe_auto_squash arg + | [(_, (p, _)); (_, (q, _))] -> + if U.term_eq p q + then w U.t_true + else squashed_head_un_auto_squash_args tm + | _ -> squashed_head_un_auto_squash_args tm + else if S.fv_eq_lid fv PC.iff_lid + then match args |> List.map simplify with + | [(Some true, _) ; (Some true, _)] + | [(Some false, _) ; (Some false, _)] -> w U.t_true + | [(Some true, _) ; (Some false, _)] + | [(Some false, _) ; (Some true, _)] -> w U.t_false + | [(_, (arg, _)) ; (Some true, _)] + | [(Some true, _) ; (_, (arg, _))] -> maybe_auto_squash arg + | [(_, (arg, _)) ; (Some false, _)] + | [(Some false, _) ; (_, (arg, _))] -> maybe_auto_squash (U.mk_neg arg) + | [(_, (p, _)); (_, (q, _))] -> + if U.term_eq p q + then w U.t_true + else squashed_head_un_auto_squash_args tm + | _ -> squashed_head_un_auto_squash_args tm + else if S.fv_eq_lid fv PC.not_lid + then match args |> List.map simplify with + | [(Some true, _)] -> w U.t_false + | [(Some false, _)] -> w U.t_true + | _ -> squashed_head_un_auto_squash_args tm + else if S.fv_eq_lid fv PC.forall_lid + then match args with + (* Simplify ∀x. True to True *) + | [(t, _)] -> + begin match (SS.compress t).n with + | Tm_abs {bs=[_]; body} -> + (match simp_t body with + | Some true -> w U.t_true + | _ -> tm) + | _ -> tm + end + (* Simplify ∀x. True to True, and ∀x. False to False, if the domain is not empty *) + | [(ty, Some ({ aqual_implicit = true })); (t, _)] -> + begin match (SS.compress t).n with + | Tm_abs {bs=[_]; body} -> + (match simp_t body with + | Some true -> w U.t_true + | Some false when clearly_inhabited ty -> w U.t_false + | _ -> tm) + | _ -> tm + end + | _ -> tm + else if S.fv_eq_lid fv PC.exists_lid + then match args with + (* Simplify ∃x. False to False *) + | [(t, _)] -> + begin match (SS.compress t).n with + | Tm_abs {bs=[_]; body} -> + (match simp_t body with + | Some false -> w U.t_false + | _ -> tm) + | _ -> tm + end + (* Simplify ∃x. False to False and ∃x. True to True, if the domain is not empty *) + | [(ty, Some ({ aqual_implicit = true })); (t, _)] -> + begin match (SS.compress t).n with + | Tm_abs {bs=[_]; body} -> + (match simp_t body with + | Some false -> w U.t_false + | Some true when clearly_inhabited ty -> w U.t_true + | _ -> tm) + | _ -> tm + end + | _ -> tm + else if S.fv_eq_lid fv PC.b2t_lid + then match args with + | [{n=Tm_constant (Const_bool true)}, _] -> w U.t_true + | [{n=Tm_constant (Const_bool false)}, _] -> w U.t_false + | _ -> tm //its arg is a bool, can't unsquash + else if S.fv_eq_lid fv PC.haseq_lid + then begin + (* + * AR: We try to mimic the hasEq related axioms in Prims + * and the axiom related to refinements + * For other types, such as lists, whose hasEq is derived by the typechecker, + * we leave them as is + *) + let t_has_eq_for_sure (t:S.term) :bool = + //Axioms from prims + let haseq_lids = [PC.int_lid; PC.bool_lid; PC.unit_lid; PC.string_lid] in + match (SS.compress t).n with + | Tm_fvar fv when haseq_lids |> List.existsb (fun l -> S.fv_eq_lid fv l) -> true + | _ -> false + in + if List.length args = 1 then + let t = args |> List.hd |> fst in + if t |> t_has_eq_for_sure then w U.t_true + else + match (SS.compress t).n with + | Tm_refine _ -> + let t = U.unrefine t in + if t |> t_has_eq_for_sure then w U.t_true + else + //get the hasEq term itself + let haseq_tm = + match (SS.compress tm).n with + | Tm_app {hd} -> hd + | _ -> failwith "Impossible! We have already checked that this is a Tm_app" + in + //and apply it to the unrefined type + mk_app (haseq_tm) [t |> as_arg] + | _ -> tm + else tm + end + else if S.fv_eq_lid fv PC.eq2_lid + then match args with + | [(_typ, _); (a1, _); (a2, _)] -> //eq2 + (match eq_tm env a1 a2 with + | Equal -> w U.t_true + | NotEqual -> w U.t_false + | _ -> tm) + | _ -> tm + else + begin + match U.is_auto_squash tm with + | Some (U_zero, t) + when U.is_sub_singleton t -> + //remove redundant auto_squashes + t + | _ -> + tm + end + | Tm_refine {b=bv; phi=t} -> + begin match simp_t t with + | Some true -> bv.sort + | Some false -> tm + | None -> tm + end + | Tm_match _ -> + begin match is_const_match tm with + | Some true -> w U.t_true + | Some false -> w U.t_false + | None -> tm + end + | _ -> tm diff --git a/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fsti b/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fsti new file mode 100644 index 00000000000..ba368f6f6de --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fsti @@ -0,0 +1,16 @@ +module FStar.TypeChecker.TermEqAndSimplify +open FStar.Pervasives +open FStar.Compiler.Effect +open FStar.TypeChecker.Env +open FStar.Syntax.Syntax + +type eq_result = + | Equal + | NotEqual + | Unknown + +val eq_tm (_:env_t) (t1 t2:term) : eq_result +val eq_args (_:env_t) (t1 t2:args) : eq_result +val eq_comp (_:env_t) (t1 t2:comp) : eq_result +val eq_tm_bool (e:env_t) (t1 t2:term) : bool +val simplify (debug:bool) (_:env_t) (_:term) : term diff --git a/src/typechecker/FStar.TypeChecker.Util.fst b/src/typechecker/FStar.TypeChecker.Util.fst index 29cc86c24f8..ffce4b77467 100644 --- a/src/typechecker/FStar.TypeChecker.Util.fst +++ b/src/typechecker/FStar.TypeChecker.Util.fst @@ -46,6 +46,7 @@ module TcComm = FStar.TypeChecker.Common module P = FStar.Syntax.Print module C = FStar.Parser.Const module UF = FStar.Syntax.Unionfind +module TEQ = FStar.TypeChecker.TermEqAndSimplify open FStar.Class.Setlike @@ -2654,7 +2655,7 @@ let weaken_result_typ env (e:term) (lc:lcomp) (t:typ) (use_eq:bool) : term * lco let set_result_typ (c:comp) :comp = Util.set_result_typ c t in - if Util.eq_tm t res_t = Util.Equal then begin //if the two types res_t and t are same, then just set the result type + if TEQ.eq_tm env t res_t = TEQ.Equal then begin //if the two types res_t and t are same, then just set the result type if Env.debug env <| Options.Extreme then BU.print2 "weaken_result_type::strengthen_trivial: res_t:%s is same as t:%s\n" (Print.term_to_string res_t) (Print.term_to_string t); @@ -2848,7 +2849,7 @@ let maybe_instantiate (env:Env.env) e t = let number_of_implicits t = let formals = unfolded_arrow_formals env t in let n_implicits = - match formals |> BU.prefix_until (fun ({binder_qual=imp}) -> Option.isNone imp || U.eq_bqual imp (Some Equality) = U.Equal) with + match formals |> BU.prefix_until (fun ({binder_qual=imp}) -> Option.isNone imp || U.eq_bqual imp (Some Equality)) with | None -> List.length formals | Some (implicits, _first_explicit, _rest) -> List.length implicits in n_implicits From a3ca82c2c3fd0f4ec31841e166b428e5469f4551 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Fri, 26 Apr 2024 15:45:45 -0700 Subject: [PATCH 113/239] revise equality of data constructors to return unknown if the type parameters are not equal --- .../generated/FStar_TypeChecker_Env.ml | 26 +++++++ .../generated/FStar_TypeChecker_NBETerm.ml | 51 +++++++++++--- .../FStar_TypeChecker_TermEqAndSimplify.ml | 70 +++++++++++++++---- src/typechecker/FStar.TypeChecker.Env.fst | 5 ++ src/typechecker/FStar.TypeChecker.Env.fsti | 1 + src/typechecker/FStar.TypeChecker.NBETerm.fst | 22 +++++- .../FStar.TypeChecker.TermEqAndSimplify.fst | 62 +++++++++++----- 7 files changed, 199 insertions(+), 38 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml index 0f575764d77..c724c1fbd98 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml @@ -3590,6 +3590,32 @@ let (typ_of_datacon : env -> FStar_Ident.lident -> FStar_Ident.lident) = let uu___3 = FStar_Syntax_Print.lid_to_string lid in FStar_Compiler_Util.format1 "Not a datacon: %s" uu___3 in FStar_Compiler_Effect.failwith uu___2 +let (num_datacon_ty_params : + env -> FStar_Ident.lident -> Prims.int FStar_Pervasives_Native.option) = + fun env1 -> + fun lid -> + let uu___ = lookup_qname env1 lid in + match uu___ with + | FStar_Pervasives_Native.Some + (FStar_Pervasives.Inr + ({ + FStar_Syntax_Syntax.sigel = FStar_Syntax_Syntax.Sig_datacon + { FStar_Syntax_Syntax.lid1 = uu___1; + FStar_Syntax_Syntax.us1 = uu___2; + FStar_Syntax_Syntax.t1 = uu___3; + FStar_Syntax_Syntax.ty_lid = uu___4; + FStar_Syntax_Syntax.num_ty_params = num_ty_params; + FStar_Syntax_Syntax.mutuals1 = uu___5;_}; + FStar_Syntax_Syntax.sigrng = uu___6; + FStar_Syntax_Syntax.sigquals = uu___7; + FStar_Syntax_Syntax.sigmeta = uu___8; + FStar_Syntax_Syntax.sigattrs = uu___9; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___10; + FStar_Syntax_Syntax.sigopts = uu___11;_}, + uu___12), + uu___13) + -> FStar_Pervasives_Native.Some num_ty_params + | uu___1 -> FStar_Pervasives_Native.None let (lookup_definition_qninfo_aux : Prims.bool -> delta_level Prims.list -> diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml index 8ce4cccdcc6..c168df346fd 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml @@ -495,14 +495,49 @@ let rec (eq_t : FStar_Compiler_Effect.failwith "eq_t, different number of args on Construct" else (); - (let uu___2 = FStar_Compiler_List.zip args1 args2 in - FStar_Compiler_List.fold_left - (fun acc -> - fun uu___3 -> - match uu___3 with - | ((a1, uu___4), (a2, uu___5)) -> - let uu___6 = eq_t env a1 a2 in eq_inj acc uu___6) - FStar_TypeChecker_TermEqAndSimplify.Equal uu___2)) + (let uu___2 = + let uu___3 = FStar_Syntax_Syntax.lid_of_fv v1 in + FStar_TypeChecker_Env.num_datacon_ty_params env uu___3 in + match uu___2 with + | FStar_Pervasives_Native.None -> + FStar_TypeChecker_TermEqAndSimplify.Unknown + | FStar_Pervasives_Native.Some n -> + if n <= (FStar_Compiler_List.length args1) + then + let eq_args1 as1 as2 = + FStar_Compiler_List.fold_left2 + (fun acc -> + fun uu___3 -> + fun uu___4 -> + match (uu___3, uu___4) with + | ((a1, uu___5), (a2, uu___6)) -> + let uu___7 = eq_t env a1 a2 in + eq_inj acc uu___7) + FStar_TypeChecker_TermEqAndSimplify.Equal as1 as2 in + let uu___3 = FStar_Compiler_List.splitAt n args1 in + (match uu___3 with + | (parms1, args11) -> + let uu___4 = FStar_Compiler_List.splitAt n args2 in + (match uu___4 with + | (parms2, args21) -> + let uu___5 = + let uu___6 = eq_args1 args11 args21 in + uu___6 = + FStar_TypeChecker_TermEqAndSimplify.Equal in + if uu___5 + then + let uu___6 = + let uu___7 = eq_args1 parms1 parms2 in + uu___7 = + FStar_TypeChecker_TermEqAndSimplify.Equal in + (if uu___6 + then + FStar_TypeChecker_TermEqAndSimplify.Equal + else + FStar_TypeChecker_TermEqAndSimplify.Unknown) + else + FStar_TypeChecker_TermEqAndSimplify.NotEqual)) + else FStar_TypeChecker_TermEqAndSimplify.Unknown)) else FStar_TypeChecker_TermEqAndSimplify.NotEqual | (FV (v1, us1, args1), FV (v2, us2, args2)) -> let uu___ = FStar_Syntax_Syntax.fv_eq v1 v2 in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml index cd2b0c70cef..64154508e6c 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml @@ -59,18 +59,33 @@ let rec (eq_tm : let eq_tm1 = eq_tm env in let t11 = FStar_Syntax_Util.canon_app t1 in let t21 = FStar_Syntax_Util.canon_app t2 in - let equal_data f1 args1 f2 args2 = + let equal_data f1 parms1 args1 f2 parms2 args2 = let uu___ = FStar_Syntax_Syntax.fv_eq f1 f2 in if uu___ then - let uu___1 = FStar_Compiler_List.zip args1 args2 in - FStar_Compiler_List.fold_left - (fun acc -> - fun uu___2 -> - match uu___2 with - | ((a1, q1), (a2, q2)) -> - let uu___3 = eq_tm1 a1 a2 in eq_inj acc uu___3) Equal - uu___1 + (if + ((FStar_Compiler_List.length parms1) = + (FStar_Compiler_List.length parms2)) + && + ((FStar_Compiler_List.length args1) = + (FStar_Compiler_List.length args2)) + then + let eq_arg_list as1 as2 = + FStar_Compiler_List.fold_left2 + (fun acc -> + fun uu___1 -> + fun uu___2 -> + match (uu___1, uu___2) with + | ((a1, q1), (a2, q2)) -> + let uu___3 = eq_tm1 a1 a2 in eq_inj acc uu___3) + Equal as1 as2 in + let args_eq = eq_arg_list args1 args2 in + (if args_eq = Equal + then + let parms_eq = eq_arg_list parms1 parms2 in + (if parms_eq = Equal then Equal else Unknown) + else args_eq) + else Unknown) else NotEqual in let qual_is_inj uu___ = match uu___ with @@ -103,7 +118,37 @@ let rec (eq_tm : FStar_Syntax_Syntax.Tm_fvar g) when (qual_is_inj f.FStar_Syntax_Syntax.fv_qual) && (qual_is_inj g.FStar_Syntax_Syntax.fv_qual) - -> FStar_Pervasives_Native.Some (f, args1, g, args2) + -> + let uu___3 = + let uu___4 = + let uu___5 = FStar_Syntax_Syntax.lid_of_fv f in + FStar_TypeChecker_Env.num_datacon_ty_params env + uu___5 in + let uu___5 = + let uu___6 = FStar_Syntax_Syntax.lid_of_fv g in + FStar_TypeChecker_Env.num_datacon_ty_params env + uu___6 in + (uu___4, uu___5) in + (match uu___3 with + | (FStar_Pervasives_Native.Some n1, + FStar_Pervasives_Native.Some n2) -> + if + (n1 <= (FStar_Compiler_List.length args1)) && + (n2 <= (FStar_Compiler_List.length args2)) + then + let uu___4 = + FStar_Compiler_List.splitAt n1 args1 in + (match uu___4 with + | (parms1, args11) -> + let uu___5 = + FStar_Compiler_List.splitAt n2 args2 in + (match uu___5 with + | (parms2, args21) -> + FStar_Pervasives_Native.Some + (f, parms1, args11, g, parms2, + args21))) + else FStar_Pervasives_Native.None + | uu___4 -> FStar_Pervasives_Native.None) | uu___3 -> FStar_Pervasives_Native.None)) in let t12 = FStar_Syntax_Util.unmeta t11 in let t22 = FStar_Syntax_Util.unmeta t21 in @@ -125,7 +170,8 @@ let rec (eq_tm : let uu___1 = FStar_Compiler_Util.must heads_and_args_in_case_both_data in (match uu___1 with - | (f, args1, g, args2) -> equal_data f args1 g args2) + | (f, parms1, args1, g, parms2, args2) -> + equal_data f parms1 args1 g parms2 args2) | (FStar_Syntax_Syntax.Tm_fvar f, FStar_Syntax_Syntax.Tm_fvar g) -> let uu___ = FStar_Syntax_Syntax.fv_eq f g in equal_if uu___ | (FStar_Syntax_Syntax.Tm_uinst (f, us), FStar_Syntax_Syntax.Tm_uinst @@ -171,7 +217,7 @@ let rec (eq_tm : let uu___2 = FStar_Syntax_Syntax.lid_of_fv f1 in FStar_Ident.string_of_lid uu___2 in FStar_Compiler_List.mem uu___1 injectives) - -> equal_data f1 args1 f2 args2 + -> equal_data f1 [] args1 f2 [] args2 | uu___1 -> let uu___2 = eq_tm1 h1 h2 in eq_and uu___2 (fun uu___3 -> eq_args env args1 args2)) diff --git a/src/typechecker/FStar.TypeChecker.Env.fst b/src/typechecker/FStar.TypeChecker.Env.fst index c59d0cc38e8..6ce5c890c6c 100644 --- a/src/typechecker/FStar.TypeChecker.Env.fst +++ b/src/typechecker/FStar.TypeChecker.Env.fst @@ -745,6 +745,11 @@ let typ_of_datacon env lid = | Some (Inr ({ sigel = Sig_datacon {ty_lid=l} }, _), _) -> l | _ -> failwith (BU.format1 "Not a datacon: %s" (Print.lid_to_string lid)) +let num_datacon_ty_params env lid = + match lookup_qname env lid with + | Some (Inr ({ sigel = Sig_datacon {num_ty_params} }, _), _) -> Some num_ty_params + | _ -> None + let lookup_definition_qninfo_aux rec_ok delta_levels lid (qninfo : qninfo) = let visible quals = delta_levels |> BU.for_some (fun dl -> quals |> BU.for_some (visible_at dl)) diff --git a/src/typechecker/FStar.TypeChecker.Env.fsti b/src/typechecker/FStar.TypeChecker.Env.fsti index f6d29b1ac6c..f3d76452836 100644 --- a/src/typechecker/FStar.TypeChecker.Env.fsti +++ b/src/typechecker/FStar.TypeChecker.Env.fsti @@ -344,6 +344,7 @@ val is_irreducible : env -> lident -> bool val is_type_constructor : env -> lident -> bool val num_inductive_ty_params: env -> lident -> option int val num_inductive_uniform_ty_params: env -> lident -> option int +val num_datacon_ty_params : env -> lident -> option int val delta_depth_of_qninfo : fv -> qninfo -> option delta_depth val delta_depth_of_fv : env -> fv -> delta_depth diff --git a/src/typechecker/FStar.TypeChecker.NBETerm.fst b/src/typechecker/FStar.TypeChecker.NBETerm.fst index 451f0879ac8..37fbb5a94a0 100644 --- a/src/typechecker/FStar.TypeChecker.NBETerm.fst +++ b/src/typechecker/FStar.TypeChecker.NBETerm.fst @@ -123,8 +123,26 @@ let rec eq_t env (t1 : t) (t2 : t) : TEQ.eq_result = if S.fv_eq v1 v2 then begin if List.length args1 <> List.length args2 then failwith "eq_t, different number of args on Construct"; - List.fold_left (fun acc ((a1, _), (a2, _)) -> - eq_inj acc (eq_t env a1 a2)) TEQ.Equal <| List.zip args1 args2 + match Env.num_datacon_ty_params env (lid_of_fv v1) with + | None -> TEQ.Unknown + | Some n -> + if n <= List.length args1 + then ( + let eq_args as1 as2 = + List.fold_left2 + (fun acc (a1, _) (a2, _) -> eq_inj acc (eq_t env a1 a2)) + TEQ.Equal + as1 as2 + in + let parms1, args1 = List.splitAt n args1 in + let parms2, args2 = List.splitAt n args2 in + if eq_args args1 args2 = TEQ.Equal + then if eq_args parms1 parms2 = TEQ.Equal + then TEQ.Equal + else TEQ.Unknown + else TEQ.NotEqual + ) + else TEQ.Unknown end else TEQ.NotEqual | FV(v1, us1, args1), FV(v2, us2, args2) -> diff --git a/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst b/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst index c92b131b4a7..4b2af53498d 100644 --- a/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst +++ b/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst @@ -80,20 +80,37 @@ let rec eq_tm (env:env_t) (t1:term) (t2:term) : eq_result = let eq_tm = eq_tm env in let t1 = canon_app t1 in let t2 = canon_app t2 in - let equal_data (f1:fv) (args1:Syntax.args) (f2:fv) (args2:Syntax.args) = + let equal_data (f1:fv) (parms1 args1:Syntax.args) (f2:fv) (parms2 args2:Syntax.args) = // we got constructors! we know they are injective and disjoint, so we can do some // good analysis on them if fv_eq f1 f2 then ( - assert (List.length args1 = List.length args2); - List.fold_left (fun acc ((a1, q1), (a2, q2)) -> - //if q1 <> q2 - //then failwith (U.format1 "Arguments of %s mismatch on implicit qualifier\n" - // (Ident.string_of_lid f1.fv_name.v)); - //NS: 05/06/2018 ...this does not always hold - // it's been succeeding because the assert is disabled in the non-debug builds - //assert (q1 = q2); - eq_inj acc (eq_tm a1 a2)) Equal <| List.zip args1 args2 + if List.length parms1 = List.length parms2 + && List.length args1 = List.length args2 + then ( + let eq_arg_list as1 as2 = + List.fold_left2 + (fun acc (a1, q1) (a2, q2) -> + //if q1 <> q2 + //then failwith (U.format1 "Arguments of %s mismatch on implicit qualifier\n" + // (Ident.string_of_lid f1.fv_name.v)); + //NS: 05/06/2018 ...this does not always hold + // it's been succeeding because the assert is disabled in the non-debug builds + //assert (q1 = q2); + eq_inj acc (eq_tm a1 a2)) + Equal + as1 + as2 + in + let args_eq = eq_arg_list args1 args2 in + if args_eq = Equal + then let parms_eq = eq_arg_list parms1 parms2 in + if parms_eq = Equal + then Equal + else Unknown + else args_eq + ) + else Unknown ) else NotEqual in let qual_is_inj = function @@ -101,12 +118,25 @@ let rec eq_tm (env:env_t) (t1:term) (t2:term) : eq_result = | Some (Record_ctor _) -> true | _ -> false in - let heads_and_args_in_case_both_data :option (fv * args * fv * args) = + let heads_and_args_in_case_both_data :option (fv * args * args * fv * args * args) = let head1, args1 = t1 |> unmeta |> head_and_args in let head2, args2 = t2 |> unmeta |> head_and_args in match (un_uinst head1).n, (un_uinst head2).n with - | Tm_fvar f, Tm_fvar g when qual_is_inj f.fv_qual && - qual_is_inj g.fv_qual -> Some (f, args1, g, args2) + | Tm_fvar f, Tm_fvar g + when qual_is_inj f.fv_qual && + qual_is_inj g.fv_qual -> ( + match Env.num_datacon_ty_params env (lid_of_fv f), Env.num_datacon_ty_params env (lid_of_fv g) with + | Some n1, Some n2 -> + if n1 <= List.length args1 + && n2 <= List.length args2 + then ( + let parms1, args1 = List.splitAt n1 args1 in + let parms2, args2 = List.splitAt n2 args2 in + Some (f, parms1, args1, g, parms2, args2) + ) + else None + | _ -> None + ) | _ -> None in let t1 = unmeta t1 in @@ -124,8 +154,8 @@ let rec eq_tm (env:env_t) (t1:term) (t2:term) : eq_result = equal_if (bv_eq a b) | _ when heads_and_args_in_case_both_data |> Some? -> //matches only when both are data constructors - heads_and_args_in_case_both_data |> must |> (fun (f, args1, g, args2) -> - equal_data f args1 g args2 + heads_and_args_in_case_both_data |> must |> (fun (f, parms1, args1, g, parms2, args2) -> + equal_data f parms1 args1 g parms2 args2 ) | Tm_fvar f, Tm_fvar g -> equal_if (fv_eq f g) @@ -164,7 +194,7 @@ let rec eq_tm (env:env_t) (t1:term) (t2:term) : eq_result = | Tm_app {hd=h1; args=args1}, Tm_app {hd=h2; args=args2} -> begin match (un_uinst h1).n, (un_uinst h2).n with | Tm_fvar f1, Tm_fvar f2 when fv_eq f1 f2 && List.mem (string_of_lid (lid_of_fv f1)) injectives -> - equal_data f1 args1 f2 args2 + equal_data f1 [] args1 f2 [] args2 | _ -> // can only assert they're equal if they syntactically match, nothing else eq_and (eq_tm h1 h2) (fun () -> eq_args env args1 args2) From bd73c3b30138842d7087a6eb154aff8e7cb7228a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 26 Apr 2024 10:28:58 -0700 Subject: [PATCH 114/239] Rel: make unifier aware of logical vs non-logical problems For logical problems, unfolding logical connectives is forbidden (UnfoldTac) --- src/typechecker/FStar.TypeChecker.Common.fsti | 1 + src/typechecker/FStar.TypeChecker.Rel.fst | 66 ++++++++++++------- src/typechecker/FStar.TypeChecker.Rel.fsti | 2 +- 3 files changed, 45 insertions(+), 24 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.Common.fsti b/src/typechecker/FStar.TypeChecker.Common.fsti index 8e91e651af0..ab9d90a439d 100644 --- a/src/typechecker/FStar.TypeChecker.Common.fsti +++ b/src/typechecker/FStar.TypeChecker.Common.fsti @@ -58,6 +58,7 @@ type problem 'a = { //Try to prove: lhs rel rhs ~ guard reason: list string; //why we generated this problem, for error reporting loc: Range.range; //and the source location where this arose rank: option rank_t; + logical : bool; //logical problems cannot unfold connectives } type prob = diff --git a/src/typechecker/FStar.TypeChecker.Rel.fst b/src/typechecker/FStar.TypeChecker.Rel.fst index 398766f82a2..2bd92dbf9e0 100644 --- a/src/typechecker/FStar.TypeChecker.Rel.fst +++ b/src/typechecker/FStar.TypeChecker.Rel.fst @@ -342,11 +342,13 @@ let term_to_string t = let prob_to_string env prob = match prob with | TProb p -> - BU.format "\n%s:\t%s \n\t\t%s\n\t%s\n" //\twith guard %s\n\telement= %s\n" // (guard %s)\n\t\t\n\t\t\t%s\n\t\t" + BU.format "\n%s:\t%s \n\t\t%s\n\t%s\n\t(reason:%s) (logical:%s)\n" //\twith guard %s\n\telement= %s\n" // (guard %s)\n\t\t\n\t\t\t%s\n\t\t" [(BU.string_of_int p.pid); (term_to_string p.lhs); (rel_to_string p.relation); (term_to_string p.rhs); + (match p.reason with | [] -> "" | r::_ -> r); + (show p.logical) //(term_to_string p.logical_guard); //(match p.element with None -> "none" | Some t -> term_to_string t) (* (N.term_to_string env (fst p.logical_guard)); *) @@ -432,6 +434,13 @@ let mk_eq2 wl prob t1 t2 : term * worklist = let p_invert = function | TProb p -> TProb <| invert p | CProb p -> CProb <| invert p +let p_logical = function + | TProb p -> p.logical + | CProb p -> p.logical +let set_logical (b:bool) = function + | TProb p -> TProb {p with logical=b} + | CProb p -> CProb {p with logical=b} + let is_top_level_prob p = p_reason p |> List.length = 1 let next_pid = let ctr = BU.mk_ref 0 in @@ -470,6 +479,7 @@ let mk_problem wl scope orig lhs rel rhs elt reason = reason=reason::p_reason orig; loc=p_loc orig; rank=None; + logical=p_logical orig; } in (prob, wl) @@ -521,6 +531,7 @@ let new_problem wl env lhs rel rhs (subject:option bv) loc reason = reason=[reason]; loc=loc; rank=None; + logical=false; (* use set_logical to set this *) } in prob, wl @@ -536,6 +547,7 @@ let problem_using_guard orig lhs rel rhs elt reason = reason=reason::p_reason orig; loc=p_loc orig; rank=None; + logical = p_logical orig; } in def_check_prob reason (TProb p); p @@ -1331,7 +1343,11 @@ let rec head_matches env t1 t2 : match_result = | _ -> MisMatch(delta_depth_of_term env t1, delta_depth_of_term env t2) (* Does t1 head-match t2, after some delta steps? *) -let head_matches_delta env smt_ok t1 t2 : (match_result & option (typ&typ)) = +let head_matches_delta env (logical:bool) smt_ok t1 t2 : (match_result & option (typ&typ)) = + let base_steps = + (if logical then [Env.UnfoldTac] else []) @ + [Env.Primops; Env.Weak; Env.HNF] + in let maybe_inline t = let head = U.head_of (unrefine env t) in if Env.debug env <| Options.Other "RelDelta" then @@ -1351,6 +1367,7 @@ let head_matches_delta env smt_ok t1 t2 : (match_result & option (typ&typ)) = None | Some _ -> let basic_steps = + (if logical then [Env.UnfoldTac] else []) @ [Env.UnfoldUntil delta_constant; Env.Weak; Env.HNF; @@ -1403,9 +1420,9 @@ let head_matches_delta env smt_ok t1 t2 : (match_result & option (typ&typ)) = let d1_greater_than_d2 = Common.delta_depth_greater_than d1 d2 in let t1, t2, made_progress = if d1_greater_than_d2 - then let t1' = normalize_refinement [Env.UnfoldUntil d2; Env.Primops; Env.Weak; Env.HNF] env t1 in + then let t1' = normalize_refinement (Env.UnfoldUntil d2 :: base_steps) env t1 in t1', t2, made_progress t1 t1' - else let t2' = normalize_refinement [Env.UnfoldUntil d1; Env.Primops; Env.Weak; Env.HNF] env t2 in + else let t2' = normalize_refinement (Env.UnfoldUntil d1 :: base_steps) env t2 in t1, t2', made_progress t2 t2' in if made_progress then aux retry (n_delta + 1) t1 t2 @@ -1416,8 +1433,8 @@ let head_matches_delta env smt_ok t1 t2 : (match_result & option (typ&typ)) = match Common.decr_delta_depth d with | None -> fail n_delta r t1 t2 | Some d -> - let t1' = normalize_refinement [Env.UnfoldUntil d; Env.Primops; Env.Weak; Env.HNF] env t1 in - let t2' = normalize_refinement [Env.UnfoldUntil d; Env.Primops; Env.Weak; Env.HNF] env t2 in + let t1' = normalize_refinement (Env.UnfoldUntil d :: base_steps) env t1 in + let t2' = normalize_refinement (Env.UnfoldUntil d :: base_steps) env t2 in if made_progress t1 t1' && made_progress t2 t2' then aux retry (n_delta + 1) t1' t2' @@ -2315,7 +2332,7 @@ and solve_rigid_flex_or_flex_rigid_subtyping let pairwise t1 t2 wl = if debug wl <| Options.Other "Rel" then BU.print2 "[meet/join]: pairwise: %s and %s\n" (show t1) (show t2); - let mr, ts = head_matches_delta (p_env wl (TProb tp)) wl.smt_ok t1 t2 in + let mr, ts = head_matches_delta (p_env wl (TProb tp)) tp.logical wl.smt_ok t1 t2 in match mr with | HeadMatch true | MisMatch _ -> @@ -3645,7 +3662,8 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = then begin let prob, wl = new_problem wl env scrutinee EQ pat_term None scrutinee.pos - "match heuristic" in + "match heuristic" + in let wl' = extend_wl ({wl with defer_ok=NoDefer; smt_ok=false; @@ -3713,7 +3731,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = if pat_discriminates b then let (_, _, t') = SS.open_branch b in - match head_matches_delta (p_env wl orig) wl.smt_ok s t' with + match head_matches_delta (p_env wl orig) (p_logical orig) wl.smt_ok s t' with | FullMatch, _ | HeadMatch _, _ -> true @@ -3762,7 +3780,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = (Print.tag_of_term t2) (show t1) (show t2); - let m, o = head_matches_delta (p_env wl orig) wl.smt_ok t1 t2 in + let m, o = head_matches_delta (p_env wl orig) (p_logical orig) wl.smt_ok t1 t2 in match m, o with | (MisMatch _, _) -> //heads definitely do not match let try_reveal_hide t1 t2 = @@ -3972,7 +3990,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = *) let env = p_env wl (TProb problem) in let x1, x2 = - match head_matches_delta env wl.smt_ok x1.sort x2.sort with + match head_matches_delta env false wl.smt_ok x1.sort x2.sort with (* We allow (HeadMatch true) since we're gonna unify them again anyway via base_prob *) | FullMatch, Some (t1, t2) | HeadMatch _, Some (t1, t2) -> @@ -4000,17 +4018,17 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = let phi1 = Subst.subst subst phi1 in let phi2 = Subst.subst subst phi2 in let mk_imp imp phi1 phi2 = imp phi1 phi2 |> guard_on_element wl problem x1 in - let fallback () = - let impl = - if problem.relation = EQ - then mk_imp U.mk_iff phi1 phi2 - else mk_imp U.mk_imp phi1 phi2 in - let guard = U.mk_conj (p_guard base_prob) impl in - def_check_scoped (p_loc orig) "ref.1" (List.map (fun b -> b.binder_bv) (p_scope orig)) (p_guard base_prob); - def_check_scoped (p_loc orig) "ref.2" (List.map (fun b -> b.binder_bv) (p_scope orig)) impl; - let wl = solve_prob orig (Some guard) [] wl in - solve (attempt [base_prob] wl) - in + let fallback () = + let impl = + if problem.relation = EQ + then mk_imp U.mk_iff phi1 phi2 + else mk_imp U.mk_imp phi1 phi2 in + let guard = U.mk_conj (p_guard base_prob) impl in + def_check_scoped (p_loc orig) "ref.1" (List.map (fun b -> b.binder_bv) (p_scope orig)) (p_guard base_prob); + def_check_scoped (p_loc orig) "ref.2" (List.map (fun b -> b.binder_bv) (p_scope orig)) impl; + let wl = solve_prob orig (Some guard) [] wl in + solve (attempt [base_prob] wl) + in let has_uvars = not (is_empty (FStar.Syntax.Free.uvars phi1)) || not (is_empty (FStar.Syntax.Free.uvars phi2)) @@ -4020,6 +4038,8 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = then let ref_prob, wl = mk_t_problem wl [mk_binder x1] orig phi1 EQ phi2 None "refinement formula" in + let ref_prob = set_logical true ref_prob in + let tx = UF.new_transaction () in (* We set wl_implicits to false, since in the success case we will * extend the original wl with the extra implicits we get, and we @@ -4118,7 +4138,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = then let flex, wl = destruct_flex_t not_abs wl in solve_t_flex_rigid_eq orig wl flex t_abs else begin - match head_matches_delta env wl.smt_ok not_abs t_abs with + match head_matches_delta env false wl.smt_ok not_abs t_abs with | HeadMatch _, Some (not_abs', _) -> solve_t ({problem with lhs=not_abs'; rhs=t_abs}) wl diff --git a/src/typechecker/FStar.TypeChecker.Rel.fsti b/src/typechecker/FStar.TypeChecker.Rel.fsti index 5eb6e62a0bf..aecadb6b4a4 100644 --- a/src/typechecker/FStar.TypeChecker.Rel.fsti +++ b/src/typechecker/FStar.TypeChecker.Rel.fsti @@ -48,7 +48,7 @@ val prob_to_string: env -> prob -> string val flex_prob_closing : env -> binders -> prob -> bool -val head_matches_delta (env:env) (smt_ok:bool) (t1 t2:typ) : (match_result & option (typ & typ)) +val head_matches_delta (env:env) (logical:bool) (smt_ok:bool) (t1 t2:typ) : (match_result & option (typ & typ)) val may_relate_with_logical_guard (env:env) (is_equality:bool) (head:typ) : bool val guard_to_string : env -> guard_t -> string val simplify_guard : env -> guard_t -> guard_t From e95c07000068b4008f0e3279692bb6d36928ee2e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 26 Apr 2024 15:16:30 -0700 Subject: [PATCH 115/239] Core: remove custom delta_depth computation --- src/typechecker/FStar.TypeChecker.Core.fst | 30 +++++++--------------- 1 file changed, 9 insertions(+), 21 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.Core.fst b/src/typechecker/FStar.TypeChecker.Core.fst index c353707ad82..9ee5513a596 100644 --- a/src/typechecker/FStar.TypeChecker.Core.fst +++ b/src/typechecker/FStar.TypeChecker.Core.fst @@ -739,27 +739,15 @@ let combine_path_and_branch_condition (path_condition:term) next_path_condition //:bool let maybe_relate_after_unfolding (g:Env.env) t0 t1 : side = - let rec delta_depth_of_head t = - let head = U.leftmost_head t in - match (U.un_uinst head).n with - | Tm_fvar fv -> Some (Env.delta_depth_of_fv g fv) - | Tm_match {scrutinee=t} -> delta_depth_of_head t - | _ -> None in - - let dd0 = delta_depth_of_head t0 in - let dd1 = delta_depth_of_head t1 in - - match dd0, dd1 with - | Some _, None -> Left - | None, Some _ -> Right - | Some dd0, Some dd1 -> - if dd0 = dd1 - then Both - else if Common.delta_depth_greater_than dd0 dd1 - then Left - else Right - | None, None -> - Neither + let dd0 = Env.delta_depth_of_term g t0 in + let dd1 = Env.delta_depth_of_term g t1 in + + if dd0 = dd1 then + Both + else if Common.delta_depth_greater_than dd0 dd1 then + Left + else + Right (* G |- e : t0 <: t1 | p From 2c178cdfe8cd031f57d8eef26f200eaad230fd38 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 24 Apr 2024 17:50:08 -0700 Subject: [PATCH 116/239] Removing fv_delta --- src/syntax/FStar.Syntax.DsEnv.fst | 52 ++--- src/syntax/FStar.Syntax.DsEnv.fsti | 4 +- src/syntax/FStar.Syntax.Syntax.fst | 12 +- src/syntax/FStar.Syntax.Syntax.fsti | 5 +- src/syntax/FStar.Syntax.Util.fst | 52 ++--- src/tactics/FStar.Tactics.Hooks.fst | 8 +- src/tosyntax/FStar.ToSyntax.ToSyntax.fst | 144 +++++-------- src/typechecker/FStar.TypeChecker.DMFF.fst | 13 +- .../FStar.TypeChecker.DeferredImplicits.fst | 5 - src/typechecker/FStar.TypeChecker.Env.fst | 199 +++++++++--------- src/typechecker/FStar.TypeChecker.Env.fsti | 5 +- .../FStar.TypeChecker.Normalize.fst | 4 +- src/typechecker/FStar.TypeChecker.Rel.fst | 70 ++---- src/typechecker/FStar.TypeChecker.Tc.fst | 25 +++ .../FStar.TypeChecker.TcInductive.fst | 7 +- 15 files changed, 263 insertions(+), 342 deletions(-) diff --git a/src/syntax/FStar.Syntax.DsEnv.fst b/src/syntax/FStar.Syntax.DsEnv.fst index 6635464f5b7..65470c0fb77 100644 --- a/src/syntax/FStar.Syntax.DsEnv.fst +++ b/src/syntax/FStar.Syntax.DsEnv.fst @@ -40,7 +40,7 @@ module BU = FStar.Compiler.Util module Const = FStar.Parser.Const type local_binding = (ident * bv * used_marker) (* local name binding for name resolution, paired with an env-generated unique name *) -type rec_binding = (ident * lid * delta_depth * (* name bound by recursive type and top-level let-bindings definitions only *) +type rec_binding = (ident * lid * (* name bound by recursive type and top-level let-bindings definitions only *) used_marker) (* this ref marks whether it was used, so we can warn if not *) type scope_mod = @@ -186,13 +186,13 @@ let set_bv_range bv r = let bv_to_name bv r = bv_to_name (set_bv_range bv r) -let unmangleMap = [("op_ColonColon", "Cons", delta_constant, Some Data_ctor); - ("not", "op_Negation", delta_equational, None)] +let unmangleMap = [("op_ColonColon", "Cons", Some Data_ctor); + ("not", "op_Negation", None)] let unmangleOpName (id:ident) : option term = - find_map unmangleMap (fun (x,y,dd,dq) -> + find_map unmangleMap (fun (x,y,dq) -> if string_of_id id = x - then Some (S.fvar_with_dd (lid_of_path ["Prims"; y] (range_of_id id)) dd dq) //NS delta ok + then Some (S.fvar_with_dd (lid_of_path ["Prims"; y] (range_of_id id)) dq) else None) type cont_t 'a = @@ -293,7 +293,7 @@ let try_lookup_id'' (id', _, _) -> string_of_id id' = string_of_id id in let check_rec_binding_id : rec_binding -> bool = function - (id', _, _, _) -> string_of_id id' = string_of_id id + (id', _, _) -> string_of_id id' = string_of_id id in let curmod_ns = ids_of_lid (current_module env) in let proc = function @@ -305,7 +305,7 @@ let try_lookup_id'' | Rec_binding r when check_rec_binding_id r -> - let (_, _, _, used_marker) = r in + let (_, _, used_marker) = r in used_marker := true; k_rec_binding r @@ -525,16 +525,6 @@ let ns_of_lid_equals (lid: lident) (ns: lident) = List.length (ns_of_lid lid) = List.length (ids_of_lid ns) && lid_equals (lid_of_ids (ns_of_lid lid)) ns -let delta_depth_of_declaration (lid:lident) (quals:list qualifier) = - let dd = if U.is_primop_lid lid - || (quals |> BU.for_some (function Projector _ | Discriminator _ -> true | _ -> false)) - then delta_equational - else delta_constant in - if quals |> BU.for_some (function Assumption -> true | _ -> false) - && not (quals |> BU.for_some (function New -> true | _ -> false)) - then Delta_abstract dd - else dd - let try_lookup_name any_val exclude_interf env (lid:lident) : option foundname = let occurrence_range = Ident.range_of_lid lid in @@ -542,39 +532,38 @@ let try_lookup_name any_val exclude_interf env (lid:lident) : option foundname = | (_, true) when exclude_interf -> None | (se, _) -> begin match se.sigel with - | Sig_inductive_typ _ -> Some (Term_name (S.fvar_with_dd source_lid delta_constant None, se.sigattrs)) //NS delta: ok - | Sig_datacon _ -> Some (Term_name (S.fvar_with_dd source_lid delta_constant (fv_qual_of_se se), se.sigattrs)) //NS delta: ok + | Sig_inductive_typ _ -> Some (Term_name (S.fvar_with_dd source_lid None, se.sigattrs)) + | Sig_datacon _ -> Some (Term_name (S.fvar_with_dd source_lid (fv_qual_of_se se), se.sigattrs)) | Sig_let {lbs=(_, lbs)} -> let fv = lb_fv lbs source_lid in - Some (Term_name (S.fvar_with_dd source_lid (fv.fv_delta |> must) fv.fv_qual, se.sigattrs)) + Some (Term_name (S.fvar_with_dd source_lid fv.fv_qual, se.sigattrs)) | Sig_declare_typ {lid} -> let quals = se.sigquals in if any_val //only in scope in an interface (any_val is true) or if the val is assumed || quals |> BU.for_some (function Assumption -> true | _ -> false) then let lid = Ident.set_lid_range lid (Ident.range_of_lid source_lid) in - let dd = delta_depth_of_declaration lid quals in begin match BU.find_map quals (function Reflectable refl_monad -> Some refl_monad | _ -> None) with //this is really a M?.reflect | Some refl_monad -> let refl_const = S.mk (Tm_constant (FStar.Const.Const_reflect refl_monad)) occurrence_range in Some (Term_name (refl_const, se.sigattrs)) | _ -> - Some (Term_name(fvar_with_dd lid dd (fv_qual_of_se se), se.sigattrs)) //NS delta: ok + Some (Term_name(fvar_with_dd lid (fv_qual_of_se se), se.sigattrs)) end else None | Sig_new_effect(ne) -> Some (Eff_name(se, set_lid_range ne.mname (range_of_lid source_lid))) | Sig_effect_abbrev _ -> Some (Eff_name(se, source_lid)) | Sig_splice {lids; tac=t} -> // TODO: This depth is probably wrong - Some (Term_name (S.fvar_with_dd source_lid (Delta_constant_at_level 1) None, [])) //NS delta: wrong + Some (Term_name (S.fvar_with_dd source_lid None, [])) | _ -> None end in let k_local_binding r = let t = found_local_binding (range_of_lid lid) r in Some (Term_name (t, [])) in - let k_rec_binding (id, l, dd, used_marker) = + let k_rec_binding (id, l, used_marker) = used_marker := true; - Some (Term_name(S.fvar_with_dd (set_lid_range l (range_of_lid lid)) dd None, [])) //NS delta: ok + Some (Term_name(S.fvar_with_dd (set_lid_range l (range_of_lid lid)) None, [])) in let found_unmangled = match ns_of_lid lid with @@ -652,7 +641,7 @@ let try_lookup_let env (lid:lident) = let k_global_def lid = function | ({ sigel = Sig_let {lbs=(_, lbs)} }, _) -> let fv = lb_fv lbs lid in - Some (fvar_with_dd lid (fv.fv_delta |> must) fv.fv_qual) //NS delta: ok + Some (fvar_with_dd lid fv.fv_qual) | _ -> None in resolve_in_open_namespaces' env lid (fun _ -> None) (fun _ -> None) k_global_def @@ -781,12 +770,12 @@ let try_lookup_datacon env (lid:lident) = match se with | ({ sigel = Sig_declare_typ _; sigquals = quals }, _) -> if quals |> BU.for_some (function Assumption -> true | _ -> false) - then Some (lid_and_dd_as_fv lid delta_constant None) + then Some (lid_and_dd_as_fv lid None) else None | ({ sigel = Sig_splice _ }, _) (* A spliced datacon *) | ({ sigel = Sig_datacon _ }, _) -> let qual = fv_qual_of_se (fst se) in - Some (lid_and_dd_as_fv lid delta_constant qual) + Some (lid_and_dd_as_fv lid qual) | _ -> None in resolve_in_open_namespaces' env lid (fun _ -> None) (fun _ -> None) k_global_def @@ -991,12 +980,12 @@ let push_bv env x = let (env, bv, _) = push_bv' env x in (env, bv) -let push_top_level_rec_binding env0 (x:ident) dd : env * ref bool = +let push_top_level_rec_binding env0 (x:ident) : env * ref bool = let l = qualify env0 x in if unique false true env0 l || Options.interactive () then let used_marker = BU.mk_ref false in - (push_scope_mod env0 (Rec_binding (x,l,dd,used_marker)), used_marker) + (push_scope_mod env0 (Rec_binding (x,l,used_marker)), used_marker) else raise_error (Errors.Fatal_DuplicateTopLevelNames, ("Duplicate top-level names " ^ (string_of_lid l))) (range_of_lid l) let push_sigelt' fail_on_dup env s = @@ -1402,5 +1391,4 @@ let resolve_name (e:env) (name:lident) | _ -> None ) | Some (Eff_name(se, l)) -> - let _ = delta_depth_of_declaration in - Some (Inr (S.lid_and_dd_as_fv l delta_constant None)) + Some (Inr (S.lid_and_dd_as_fv l None)) diff --git a/src/syntax/FStar.Syntax.DsEnv.fsti b/src/syntax/FStar.Syntax.DsEnv.fsti index f8379d61251..9449f6f35a8 100644 --- a/src/syntax/FStar.Syntax.DsEnv.fsti +++ b/src/syntax/FStar.Syntax.DsEnv.fsti @@ -20,6 +20,7 @@ open FStar.Compiler.Effect open FStar open FStar.Compiler open FStar.Compiler.Util +open FStar.Compiler.Effect open FStar.Syntax open FStar.Syntax.Syntax open FStar.Syntax.Util @@ -110,11 +111,10 @@ val lookup_letbinding_quals_and_attrs: env -> lident -> list qualifier * list at val resolve_module_name: env:env -> lid:lident -> honor_ns:bool -> option lident val resolve_to_fully_qualified_name : env:env -> l:lident -> option lident val fv_qual_of_se : sigelt -> option fv_qual -val delta_depth_of_declaration: lident -> list qualifier -> delta_depth val push_bv': env -> ident -> env * bv * used_marker val push_bv: env -> ident -> env * bv -val push_top_level_rec_binding: env -> ident -> S.delta_depth -> env * ref bool +val push_top_level_rec_binding: env -> ident -> env * ref bool val push_sigelt: env -> sigelt -> env val push_namespace: env -> lident -> env val push_include: env -> lident -> env diff --git a/src/syntax/FStar.Syntax.Syntax.fst b/src/syntax/FStar.Syntax.Syntax.fst index 84fd96b0b9e..3046c83fbf4 100644 --- a/src/syntax/FStar.Syntax.Syntax.fst +++ b/src/syntax/FStar.Syntax.Syntax.fst @@ -320,18 +320,16 @@ let fv_eq_lid fv lid = lid_equals fv.fv_name.v lid let set_bv_range bv r = {bv with ppname = set_id_range r bv.ppname} -let lid_and_dd_as_fv l dd dq : fv = { +let lid_and_dd_as_fv l dq : fv = { fv_name=withinfo l (range_of_lid l); - fv_delta=Some dd; fv_qual =dq; } let lid_as_fv l dq : fv = { fv_name=withinfo l (range_of_lid l); - fv_delta=None; fv_qual =dq; } let fv_to_tm (fv:fv) : term = mk (Tm_fvar fv) (range_of_lid fv.fv_name.v) -let fvar_with_dd l dd dq = fv_to_tm (lid_and_dd_as_fv l dd dq) +let fvar_with_dd l dq = fv_to_tm (lid_and_dd_as_fv l dq) let fvar l dq = fv_to_tm (lid_as_fv l dq) let lid_of_fv (fv:fv) = fv.fv_name.v let range_of_fv (fv:fv) = range_of_lid (lid_of_fv fv) @@ -368,10 +366,10 @@ let rec eq_pat (p1 : pat) (p2 : pat) : bool = /////////////////////////////////////////////////////////////////////// let delta_constant = Delta_constant_at_level 0 let delta_equational = Delta_equational_at_level 0 -let fvconst l = lid_and_dd_as_fv l delta_constant None +let fvconst l = lid_and_dd_as_fv l None let tconst l = mk (Tm_fvar (fvconst l)) Range.dummyRange -let tabbrev l = mk (Tm_fvar(lid_and_dd_as_fv l (Delta_constant_at_level 1) None)) Range.dummyRange -let tdataconstr l = fv_to_tm (lid_and_dd_as_fv l delta_constant (Some Data_ctor)) +let tabbrev l = mk (Tm_fvar(lid_and_dd_as_fv l None)) Range.dummyRange +let tdataconstr l = fv_to_tm (lid_and_dd_as_fv l (Some Data_ctor)) let t_unit = tconst PC.unit_lid let t_bool = tconst PC.bool_lid let t_int = tconst PC.int_lid diff --git a/src/syntax/FStar.Syntax.Syntax.fsti b/src/syntax/FStar.Syntax.Syntax.fsti index 96c47947b17..6bc57696c67 100644 --- a/src/syntax/FStar.Syntax.Syntax.fsti +++ b/src/syntax/FStar.Syntax.Syntax.fsti @@ -376,7 +376,6 @@ and bv = { } and fv = { fv_name :var; - fv_delta:option delta_depth; fv_qual :option fv_qual } and free_vars = { @@ -836,10 +835,10 @@ val gen_bv : string -> option Range.range -> typ -> bv val gen_bv' : ident -> option Range.range -> typ -> bv val new_bv : option range -> typ -> bv val new_univ_name : option range -> univ_name -val lid_and_dd_as_fv : lident -> delta_depth -> option fv_qual -> fv +val lid_and_dd_as_fv : lident -> option fv_qual -> fv val lid_as_fv : lident -> option fv_qual -> fv val fv_to_tm : fv -> term -val fvar_with_dd : lident -> delta_depth -> option fv_qual -> term +val fvar_with_dd : lident -> option fv_qual -> term val fvar : lident -> option fv_qual -> term val fv_eq : fv -> fv -> bool val fv_eq_lid : fv -> lident -> bool diff --git a/src/syntax/FStar.Syntax.Util.fst b/src/syntax/FStar.Syntax.Util.fst index 3f608f402cf..cd780770653 100644 --- a/src/syntax/FStar.Syntax.Util.fst +++ b/src/syntax/FStar.Syntax.Util.fst @@ -1282,17 +1282,17 @@ let exp_int s : term = mk (Tm_constant (Const_int (s,None))) dummyRange let exp_char c : term = mk (Tm_constant (Const_char c)) dummyRange let exp_string s : term = mk (Tm_constant (Const_string (s, dummyRange))) dummyRange -let fvar_const l = fvar_with_dd l delta_constant None +let fvar_const l = fvar_with_dd l None let tand = fvar_const PC.and_lid let tor = fvar_const PC.or_lid -let timp = fvar_with_dd PC.imp_lid (Delta_constant_at_level 1) None //NS delta: wrong? level 2 -let tiff = fvar_with_dd PC.iff_lid (Delta_constant_at_level 2) None //NS delta: wrong? level 3 +let timp = fvar_with_dd PC.imp_lid None +let tiff = fvar_with_dd PC.iff_lid None let t_bool = fvar_const PC.bool_lid let b2t_v = fvar_const PC.b2t_lid let t_not = fvar_const PC.not_lid // These are `True` and `False`, not the booleans -let t_false = fvar_const PC.false_lid //NS delta: wrong? should be Delta_constant_at_level 2 -let t_true = fvar_const PC.true_lid //NS delta: wrong? should be Delta_constant_at_level 2 +let t_false = fvar_const PC.false_lid +let t_true = fvar_const PC.true_lid let tac_opaque_attr = exp_string "tac_opaque" let dm4f_bind_range_attr = fvar_const PC.dm4f_bind_range_attr let tcdecltime_attr = fvar_const PC.tcdecltime_attr @@ -1312,7 +1312,7 @@ let mk_binop op_t phi1 phi2 = mk (Tm_app {hd=op_t; args=[as_arg phi1; as_arg phi let mk_neg phi = mk (Tm_app {hd=t_not; args=[as_arg phi]}) phi.pos let mk_conj phi1 phi2 = mk_binop tand phi1 phi2 let mk_conj_l phi = match phi with - | [] -> fvar_with_dd PC.true_lid delta_constant None //NS delta: wrong, see a t_true + | [] -> fvar_with_dd PC.true_lid None | hd::tl -> List.fold_right mk_conj tl hd let mk_disj phi1 phi2 = mk_binop tor phi1 phi2 let mk_disj_l phi = match phi with @@ -1357,9 +1357,9 @@ let mk_has_type t x t' = let t_has_type = mk (Tm_uinst(t_has_type, [U_zero; U_zero])) dummyRange in mk (Tm_app {hd=t_has_type; args=[iarg t; as_arg x; as_arg t']}) dummyRange -let tforall = fvar_with_dd PC.forall_lid (Delta_constant_at_level 1) None //NS delta: wrong level 2 -let texists = fvar_with_dd PC.exists_lid (Delta_constant_at_level 1) None //NS delta: wrong level 2 -let t_haseq = fvar_with_dd PC.haseq_lid delta_constant None //NS delta: wrong Delta_abstract (Delta_constant_at_level 0)? +let tforall = fvar_with_dd PC.forall_lid None +let texists = fvar_with_dd PC.exists_lid None +let t_haseq = fvar_with_dd PC.haseq_lid None let decidable_eq = fvar_const PC.op_Eq let mk_decidable_eq t e1 e2 = @@ -1433,11 +1433,11 @@ let if_then_else b t1 t2 = // Operations on squashed and other irrelevant/sub-singleton types ////////////////////////////////////////////////////////////////////////////////////// let mk_squash u p = - let sq = fvar_with_dd PC.squash_lid (Delta_constant_at_level 1) None in //NS delta: ok + let sq = fvar_with_dd PC.squash_lid None in mk_app (mk_Tm_uinst sq [u]) [as_arg p] let mk_auto_squash u p = - let sq = fvar_with_dd PC.auto_squash_lid (Delta_constant_at_level 2) None in //NS delta: ok + let sq = fvar_with_dd PC.auto_squash_lid None in mk_app (mk_Tm_uinst sq [u]) [as_arg p] let un_squash t = @@ -1534,7 +1534,7 @@ let is_free_in (bv:bv) (t:term) : bool = let action_as_lb eff_lid a pos = let lb = close_univs_and_mk_letbinding None - (Inr (lid_and_dd_as_fv a.action_name delta_equational None)) + (Inr (lid_and_dd_as_fv a.action_name None)) a.action_univs (arrow a.action_params (mk_Total a.action_typ)) PC.effect_Tot_lid @@ -1563,40 +1563,12 @@ let mk_reflect t = (* Some utilities for clients who wish to build top-level bindings and keep * their delta-qualifiers correct (e.g. dmff). *) -let rec delta_qualifier t = - let t = Subst.compress t in - match t.n with - | Tm_delayed _ -> failwith "Impossible" - | Tm_lazy i -> delta_qualifier (unfold_lazy i) - | Tm_fvar fv -> (match fv.fv_delta with - | Some d -> d - | None -> delta_constant) - | Tm_bvar _ - | Tm_name _ - | Tm_match _ - | Tm_uvar _ - | Tm_unknown -> delta_equational - | Tm_type _ - | Tm_quoted _ - | Tm_constant _ - | Tm_arrow _ -> delta_constant - | Tm_uinst(t, _) - | Tm_refine {b={sort=t}} - | Tm_meta {tm=t} - | Tm_ascribed {tm=t} - | Tm_app {hd=t} - | Tm_abs {body=t} - | Tm_let {body=t} -> delta_qualifier t - let rec incr_delta_depth d = match d with | Delta_constant_at_level i -> Delta_constant_at_level (i + 1) | Delta_equational_at_level i -> Delta_equational_at_level (i + 1) | Delta_abstract d -> incr_delta_depth d -let incr_delta_qualifier t = - incr_delta_depth (delta_qualifier t) - let is_unknown t = match (Subst.compress t).n with | Tm_unknown -> true | _ -> false let rec apply_last f l = match l with diff --git a/src/tactics/FStar.Tactics.Hooks.fst b/src/tactics/FStar.Tactics.Hooks.fst index c11516170fa..d2bc17d5f5b 100644 --- a/src/tactics/FStar.Tactics.Hooks.fst +++ b/src/tactics/FStar.Tactics.Hooks.fst @@ -787,11 +787,6 @@ let handle_smt_goal env goal = | Sig_let {lids=[lid]} -> let qn = Env.lookup_qname env lid in let fv = S.lid_as_fv lid None in - let dd = - match Env.delta_depth_of_qninfo fv qn with - | Some dd -> dd - | None -> failwith "Expected a dd" - in S.fv_to_tm (S.lid_as_fv lid None) | _ -> failwith "Resolve_tac not found" in @@ -867,8 +862,7 @@ let splice (env:Env.env) (is_typed:bool) (lids:list Ident.lident) (tau:term) (rn let sigelts = let set_lb_dd lb = let {lbname=Inr fv; lbdef} = lb in - {lb with lbname=Inr {fv with fv_delta=U.incr_delta_qualifier lbdef - |> Some}} in + {lb with lbname=Inr fv} in List.map (fun se -> match se.sigel with | Sig_let {lbs=(is_rec, lbs); lids} -> diff --git a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst index 430f8b73215..f6d0fa59c4c 100644 --- a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst +++ b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst @@ -219,33 +219,21 @@ let desugar_name mk setpos env resolve l = let compile_op_lid n s r = [mk_ident(compile_op n s r, r)] |> lid_of_ids let op_as_term env arity op : option S.term = - let r l dd = Some (S.lid_and_dd_as_fv (set_lid_range l (range_of_id op)) dd None |> S.fv_to_tm) in + let r l = Some (S.lid_and_dd_as_fv (set_lid_range l (range_of_id op)) None |> S.fv_to_tm) in let fallback () = match Ident.string_of_id op with - | "=" -> - r C.op_Eq delta_equational - | "<" -> - r C.op_LT delta_equational - | "<=" -> - r C.op_LTE delta_equational - | ">" -> - r C.op_GT delta_equational - | ">=" -> - r C.op_GTE delta_equational - | "&&" -> - r C.op_And delta_equational - | "||" -> - r C.op_Or delta_equational - | "+" -> - r C.op_Addition delta_equational - | "-" when (arity=1) -> - r C.op_Minus delta_equational - | "-" -> - r C.op_Subtraction delta_equational - | "/" -> - r C.op_Division delta_equational - | "%" -> - r C.op_Modulus delta_equational + | "=" -> r C.op_Eq + | "<" -> r C.op_LT + | "<=" -> r C.op_LTE + | ">" -> r C.op_GT + | ">=" -> r C.op_GTE + | "&&" -> r C.op_And + | "||" -> r C.op_Or + | "+" -> r C.op_Addition + | "-" when (arity=1) -> r C.op_Minus + | "-" -> r C.op_Subtraction + | "/" -> r C.op_Division + | "%" -> r C.op_Modulus | "@" -> FStar.Errors.log_issue_doc (range_of_id op) @@ -253,24 +241,16 @@ let op_as_term env arity op : option S.term = Errors.Msg.text "The operator '@' has been resolved to FStar.List.Tot.append even though \ FStar.List.Tot is not in scope. Please add an 'open FStar.List.Tot' to \ stop relying on this deprecated, special treatment of '@'."]); - r C.list_tot_append_lid (Delta_equational_at_level 2) - - | "<>" -> - r C.op_notEq delta_equational - | "~" -> - r C.not_lid (Delta_constant_at_level 2) - | "==" -> - r C.eq2_lid (Delta_constant_at_level 2) - | "<<" -> - r C.precedes_lid delta_constant - | "/\\" -> - r C.and_lid (Delta_constant_at_level 1) - | "\\/" -> - r C.or_lid (Delta_constant_at_level 1) - | "==>" -> - r C.imp_lid (Delta_constant_at_level 1) - | "<==>" -> - r C.iff_lid (Delta_constant_at_level 2) + r C.list_tot_append_lid + + | "<>" -> r C.op_notEq + | "~" -> r C.not_lid + | "==" -> r C.eq2_lid + | "<<" -> r C.precedes_lid + | "/\\" -> r C.and_lid + | "\\/" -> r C.or_lid + | "==>" -> r C.imp_lid + | "<==>" -> r C.iff_lid | _ -> None in match desugar_name' (fun t -> {t with pos=(range_of_id op)}) @@ -954,8 +934,8 @@ let rec desugar_data_pat loc, aqs, env, ans@annots, pat::pats) pats (loc, aqs, env, [], []) in let pat = List.fold_right (fun hd tl -> let r = Range.union_ranges hd.p tl.p in - pos_r r <| Pat_cons(S.lid_and_dd_as_fv C.cons_lid delta_constant (Some Data_ctor), None, [(hd, false);(tl, false)])) pats - (pos_r (Range.end_range p.prange) <| Pat_cons(S.lid_and_dd_as_fv C.nil_lid delta_constant (Some Data_ctor), None, [])) in + pos_r r <| Pat_cons(S.lid_and_dd_as_fv C.cons_lid (Some Data_ctor), None, [(hd, false);(tl, false)])) pats + (pos_r (Range.end_range p.prange) <| Pat_cons(S.lid_and_dd_as_fv C.nil_lid (Some Data_ctor), None, [])) in let x = S.new_bv (Some p.prange) (tun_r p.prange) in loc, aqs, env, LocalBinder(x, None, []), pat, annots @@ -990,7 +970,6 @@ let rec desugar_data_pat let lid = lid_of_path ["__dummy__"] p.prange in S.lid_and_dd_as_fv lid - delta_constant (Some (Unresolved_constructor ({ uc_base_term = false; @@ -1125,7 +1104,7 @@ and desugar_machine_integer env repr (signedness, width) range = begin match intro_term.n with | Tm_fvar fv -> let private_lid = lid_of_path (path_of_text private_intro_nm) range in - let private_fv = S.lid_and_dd_as_fv private_lid (U.incr_delta_depth (Some?.v fv.fv_delta)) fv.fv_qual in + let private_fv = S.lid_and_dd_as_fv private_lid fv.fv_qual in {intro_term with n=Tm_fvar private_fv} | _ -> failwith ("Unexpected non-fvar for " ^ intro_nm) @@ -1261,10 +1240,10 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an | Name lid when string_of_lid lid = "Effect" -> mk (Tm_constant Const_effect), noaqs | Name lid when string_of_lid lid = "True" -> - S.fvar_with_dd (Ident.set_lid_range Const.true_lid top.range) delta_constant None, //NS delta: wrong, but maybe intentionally so + S.fvar_with_dd (Ident.set_lid_range Const.true_lid top.range) None, noaqs | Name lid when string_of_lid lid = "False" -> - S.fvar_with_dd (Ident.set_lid_range Const.false_lid top.range) delta_constant None, //NS delta: wrong, but maybe intentionally so + S.fvar_with_dd (Ident.set_lid_range Const.false_lid top.range) None, noaqs | Projector (eff_name, id) when is_special_effect_combinator (string_of_id id) && Env.is_effect_name env eff_name -> @@ -1274,7 +1253,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an begin match try_lookup_effect_defn env eff_name with | Some ed -> let lid = U.dm4f_lid ed txt in - S.fvar_with_dd lid (Delta_constant_at_level 1) None, noaqs + S.fvar_with_dd lid None, noaqs | None -> failwith (BU.format2 "Member %s of effect %s is not accessible \ (using an effect abbreviation instead of the original effect ?)" @@ -1475,13 +1454,13 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an | Some p, Some (sc, p') -> begin match sc.n, p'.v with | Tm_name _, _ -> - let tup2 = S.lid_and_dd_as_fv (C.mk_tuple_data_lid 2 top.range) delta_constant (Some Data_ctor) in + let tup2 = S.lid_and_dd_as_fv (C.mk_tuple_data_lid 2 top.range) (Some Data_ctor) in let sc = S.mk (Tm_app {hd=mk (Tm_fvar tup2); args=[as_arg sc; as_arg <| S.bv_to_name x]}) top.range in let p = withinfo (Pat_cons(tup2, None, [(p', false);(p, false)])) (Range.union_ranges p'.p p.p) in Some(sc, p) | Tm_app {args}, Pat_cons(_, _, pats) -> - let tupn = S.lid_and_dd_as_fv (C.mk_tuple_data_lid (1 + List.length args) top.range) delta_constant (Some Data_ctor) in + let tupn = S.lid_and_dd_as_fv (C.mk_tuple_data_lid (1 + List.length args) top.range) (Some Data_ctor) in let sc = mk (Tm_app {hd=mk (Tm_fvar tupn); args=args@[as_arg <| S.bv_to_name x]}) in let p = withinfo (Pat_cons(tupn, None, pats@[(p, false)])) (Range.union_ranges p'.p p.p) in @@ -1629,7 +1608,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let dummy_ref = BU.mk_ref true in env, Inl xx, S.mk_binder xx::rec_bindings, used_marker::used_markers | Inr l -> - let env, used_marker = push_top_level_rec_binding env (ident_of_lid l) S.delta_equational in + let env, used_marker = push_top_level_rec_binding env (ident_of_lid l) in env, Inr l, rec_bindings, used_marker::used_markers in env, (lbname::fnames), rec_bindings, used_markers) (env, [], [], []) funs in @@ -1688,7 +1667,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let body, aq = desugar_term_aq env def in let lbname = match lbname with | Inl x -> Inl x - | Inr l -> Inr (S.lid_and_dd_as_fv l (incr_delta_qualifier body) None) in + | Inr l -> Inr (S.lid_and_dd_as_fv l None) in let body = if is_rec then Subst.close rec_bindings body else body in let attrs = match attrs_opt with | None -> [] @@ -1738,7 +1717,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an "Tactic annotation with a value type is not supported yet, \ try annotating with a computation type; this tactic annotation will be ignored"); let body, aq = desugar_term_aq env t2 in - let fv = S.lid_and_dd_as_fv l (incr_delta_qualifier t1) None in + let fv = S.lid_and_dd_as_fv l None in mk <| Tm_let {lbs=(false, [mk_lb (attrs, Inr fv, t, t1, t1.pos)]); body}, aq | LocalBinder (x,_,_) -> @@ -1777,7 +1756,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an | If(t1, None, asc_opt, t2, t3) -> let x = Syntax.new_bv (Some t3.range) (tun_r t3.range) in - let t_bool = mk (Tm_fvar(S.lid_and_dd_as_fv C.bool_lid delta_constant None)) in + let t_bool = mk (Tm_fvar(S.lid_and_dd_as_fv C.bool_lid None)) in let t1', aq1 = desugar_term_aq env t1 in let t1' = U.ascribe t1' (Inl t_bool, None, false) in let asc_opt, aq0 = desugar_match_returns env t1' asc_opt in @@ -1872,7 +1851,6 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let head = let lid = lid_of_path ["__dummy__"] top.range in S.fvar_with_dd lid - delta_constant (Some (Unresolved_constructor uc)) in let mk_result args = S.mk_Tm_app head args top.range in @@ -1907,15 +1885,15 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let head = match try_lookup_dc_by_field_name env f with | None -> - S.fvar_with_dd f (Delta_equational_at_level 1) (Some (Unresolved_projector None)) + S.fvar_with_dd f (Some (Unresolved_projector None)) | Some (constrname, is_rec) -> let projname = mk_field_projector_name_from_ident constrname (ident_of_lid f) in let qual = if is_rec then Some (Record_projector (constrname, ident_of_lid f)) else None in - let candidate_projector = S.lid_and_dd_as_fv (Ident.set_lid_range projname top.range) (Delta_equational_at_level 1) qual in //NS delta: ok, projector + let candidate_projector = S.lid_and_dd_as_fv (Ident.set_lid_range projname top.range) qual in let qual = Unresolved_projector (Some candidate_projector) in let f = List.hd (qualify_field_names constrname [f]) in - S.fvar_with_dd f (Delta_equational_at_level 1) (Some qual) + S.fvar_with_dd f (Some qual) in //The fvar at the head of the term just records the fieldname that the user wrote //and in TcTerm, we use that field name combined with type info to disambiguate @@ -2054,7 +2032,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an forall_intro an (fun xn -> p) (fun xn -> e))) *) let mk_forall_intro t p pf = - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.forall_intro_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.forall_intro_lid None) in let args = [(t, None); (p, None); (pf, None)] in @@ -2089,7 +2067,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an *) let mk_exists_intro t p v e = - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.exists_intro_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.exists_intro_lid None) in let args = [(t, None); (p, None); (v, None); @@ -2120,7 +2098,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let q = desugar_term env q in let env', [x] = desugar_binders env [x] in let e = desugar_term env' e in - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.implies_intro_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.implies_intro_lid None) in let args = [(p, None); (mk_thunk q, None); (U.abs [x] e None, None)] in @@ -2136,7 +2114,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an then C.or_intro_left_lid else C.or_intro_right_lid in - let head = S.fv_to_tm (S.lid_and_dd_as_fv lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv lid None) in let args = [(p, None); (mk_thunk q, None); (mk_thunk e, None)] in @@ -2147,7 +2125,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let q = desugar_term env q in let e1 = desugar_term env e1 in let e2 = desugar_term env e2 in - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.and_intro_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.and_intro_lid None) in let args = [(p, None); (mk_thunk q, None); (mk_thunk e1, None); @@ -2165,7 +2143,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an (forall_elim #a0 #(fun x0 -> forall xs. p) v0 ()))) *) let mk_forall_elim a p v tok = - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.forall_elim_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.forall_elim_lid None) in let args = [(a, S.as_aqual_implicit true); (p, S.as_aqual_implicit true); (v, None); @@ -2204,7 +2182,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an | [] -> failwith "Impossible" | [b] -> let x = b.binder_bv in - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.exists_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.exists_lid None) in let args = [(x.sort, S.as_aqual_implicit true); (U.abs [List.hd bs] p None, None)] in S.mk_Tm_app head args p.pos @@ -2213,7 +2191,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an mk_exists [b] body in let mk_exists_elim t x_p s_ex_p f r = - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.exists_elim_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.exists_elim_lid None) in let args = [(t, S.as_aqual_implicit true); (x_p, S.as_aqual_implicit true); (s_ex_p, None); @@ -2269,7 +2247,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let p = desugar_term env p in let q = desugar_term env q in let e = desugar_term env e in - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.implies_elim_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.implies_elim_lid None) in let args = [(p, None); (q, None); ({ U.exp_unit with pos = Range.union_ranges p.pos q.pos }, None); @@ -2284,7 +2262,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let e1 = desugar_term env_x e1 in let env_y, [y] = desugar_binders env [y] in let e2 = desugar_term env_y e2 in - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.or_elim_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.or_elim_lid None) in let extra_binder = S.mk_binder (S.new_bv None S.tun) in let args = [(p, None); (mk_thunk q, None); @@ -2300,7 +2278,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let r = desugar_term env r in let env', [x;y] = desugar_binders env [x;y] in let e = desugar_term env' e in - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.and_elim_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.and_elim_lid None) in let args = [(p, None); (mk_thunk q, None); (r, None); @@ -2585,7 +2563,7 @@ and desugar_comp r (allow_type_promotion:bool) env t = | Tm_fvar fv when S.fv_eq_lid fv Const.nil_lid -> let nil = S.mk_Tm_uinst pat [U_zero] in let pattern = - S.fvar_with_dd (Ident.set_lid_range Const.pattern_lid pat.pos) delta_constant None //NS delta: incorrect, should be Delta_abstract (Delta_constant_at_level 1)? + S.fvar_with_dd (Ident.set_lid_range Const.pattern_lid pat.pos) None in S.mk_Tm_app nil [(pattern, S.as_aqual_implicit true)] pat.pos | _ -> pat @@ -2672,16 +2650,12 @@ and desugar_formula env (f:term) : S.term = | QForall([b], pats, body) -> let q = C.forall_lid in - let q_head = //NS delta: wrong? Delta_constant_at_level 2? - S.fvar_with_dd (set_lid_range q b.brange) (Delta_constant_at_level 1) None - in + let q_head = S.fvar_with_dd (set_lid_range q b.brange) None in desugar_quant q_head b pats true body | QExists([b], pats, body) -> let q = C.exists_lid in - let q_head = //NS delta: wrong? Delta_constant_at_level 2? - S.fvar_with_dd (set_lid_range q b.brange) (Delta_constant_at_level 1) None - in + let q_head = S.fvar_with_dd (set_lid_range q b.brange) None in desugar_quant q_head b pats true body | QuantOp(i, [b], pats, body) -> @@ -2834,9 +2808,8 @@ let mk_indexed_projector_names iquals fvq attrs env lid (fields:list S.binder) = if only_decl then [decl] //only the signature else - let dd = Delta_equational_at_level 1 in let lb = { - lbname=Inr (S.lid_and_dd_as_fv field_name dd None); + lbname=Inr (S.lid_and_dd_as_fv field_name None); lbunivs=[]; lbtyp=tun; lbeff=C.effect_Tot_lid; @@ -2886,9 +2859,8 @@ let mk_typ_abbrev env d lid uvs typars kopt t lids quals rng = * TopLevelLet (see comment there) *) let attrs = U.deduplicate_terms (List.map (desugar_term env) d.attrs) in let val_attrs = Env.lookup_letbinding_quals_and_attrs env lid |> snd in - let dd = incr_delta_qualifier t in let lb = { - lbname=Inr (S.lid_and_dd_as_fv lid dd None); + lbname=Inr (S.lid_and_dd_as_fv lid None); lbunivs=uvs; lbdef=no_annot_abs typars t; lbtyp=if is_some kopt then U.arrow typars (S.mk_Total (kopt |> must)) else tun; @@ -2997,8 +2969,8 @@ let rec desugar_tycon env (d: AST.decl) (d_attrs:list S.term) quals tcs : (env_t sigopts = None; sigopens_and_abbrevs = opens_and_abbrevs env } in - let _env, _ = Env.push_top_level_rec_binding _env id S.delta_constant in - let _env2, _ = Env.push_top_level_rec_binding _env' id S.delta_constant in + let _env, _ = Env.push_top_level_rec_binding _env id in + let _env2, _ = Env.push_top_level_rec_binding _env' id in _env, _env2, se, tconstr | _ -> failwith "Unexpected tycon" in let push_tparams env bs = @@ -3853,13 +3825,13 @@ and desugar_decl_core env (d_attrs:list S.term) (d:decl) : (env_t * sigelts) = let ses = List.map add_class_attr ses in { se with sigel = Sig_bundle {ses; lids} ; sigattrs = U.deduplicate_terms - (S.fvar_with_dd FStar.Parser.Const.tcclass_lid S.delta_constant None + (S.fvar_with_dd FStar.Parser.Const.tcclass_lid None :: se.sigattrs) } | Sig_inductive_typ _ -> { se with sigattrs = U.deduplicate_terms - (S.fvar_with_dd FStar.Parser.Const.tcclass_lid S.delta_constant None + (S.fvar_with_dd FStar.Parser.Const.tcclass_lid None :: se.sigattrs) } | _ -> se diff --git a/src/typechecker/FStar.TypeChecker.DMFF.fst b/src/typechecker/FStar.TypeChecker.DMFF.fst index 7e88e8e2aeb..8f57bc3b632 100644 --- a/src/typechecker/FStar.TypeChecker.DMFF.fst +++ b/src/typechecker/FStar.TypeChecker.DMFF.fst @@ -54,7 +54,7 @@ let mk_toplevel_definition (env: env_t) lident (def: term): sigelt * term = BU.print2 "Registering top-level definition: %s\n%s\n" (string_of_lid lident) (Print.term_to_string def) end; // Allocate a new top-level name. - let fv = S.lid_and_dd_as_fv lident (U.incr_delta_qualifier def) None in + let fv = S.lid_and_dd_as_fv lident None in let lbname: lbname = Inr fv in let lb: letbindings = // the effect label will be recomputed correctly @@ -299,7 +299,7 @@ let gen_wps_for_free let result_comp = (mk_Total ((U.arrow [ S.null_binder wp_a; S.null_binder wp_a ] (mk_Total wp_a)))) in let c = S.gen_bv "c" None U.ktype in U.abs (binders @ S.binders_of_list [ a; c ]) ( - let l_ite = fvar_with_dd PC.ite_lid (S.Delta_constant_at_level 2) None in + let l_ite = fvar_with_dd PC.ite_lid None in U.ascribe ( U.mk_app c_lift2 (List.map S.as_arg [ U.mk_app l_ite [S.as_arg (S.bv_to_name c)] @@ -400,7 +400,7 @@ let gen_wps_for_free | Tm_app {hd=head; args} when is_tuple_constructor (SS.compress head) -> let project i tuple = (* TODO : I guess a projector shouldn't be handled as a constant... *) - let projector = S.fvar_with_dd (Env.lookup_projector env (PC.mk_tuple_data_lid (List.length args) Range.dummyRange) i) (S.Delta_constant_at_level 1) None in + let projector = S.fvar_with_dd (Env.lookup_projector env (PC.mk_tuple_data_lid (List.length args) Range.dummyRange) i) None in mk_app projector [tuple, None] in let (rel0,rels) = @@ -438,7 +438,7 @@ let gen_wps_for_free match destruct_typ_as_formula eq with | Some (QAll (binders, [], body)) -> let k_app = U.mk_app k_tm (args_of_binders binders) in - let guard_free = S.fv_to_tm (S.lid_and_dd_as_fv PC.guard_free delta_constant None) in + let guard_free = S.fv_to_tm (S.lid_and_dd_as_fv PC.guard_free None) in let pat = U.mk_app guard_free [as_arg k_app] in let pattern_guarded_body = mk (Tm_meta {tm=body; meta=Meta_pattern(binders_to_names binders, [[as_arg pat]])}) in @@ -1535,7 +1535,7 @@ let cps_and_elaborate (env:FStar.TypeChecker.Env.env) (ed:S.eff_decl) match (SS.compress bind_wp).n with | Tm_abs {bs=binders; body; rc_opt=what} -> // TODO: figure out how to deal with ranges - //let r = S.lid_and_dd_as_fv PC.range_lid (S.Delta_constant_at_level 1) None in + //let r = S.lid_and_dd_as_fv PC.range_lid None in U.abs binders body what | _ -> raise_error (Errors.Fatal_UnexpectedBindShape, "unexpected shape for bind") @@ -1561,8 +1561,7 @@ let cps_and_elaborate (env:FStar.TypeChecker.Env.env) (ed:S.eff_decl) | Some (_us,_t) -> begin if Options.debug_any () then BU.print1 "DM4F: Applying override %s\n" (string_of_lid l'); - // TODO: GM: get exact delta depth, needs a change of interfaces - fv_to_tm (lid_and_dd_as_fv l' delta_equational None) + fv_to_tm (lid_and_dd_as_fv l' None) end | None -> let sigelt, fv = mk_toplevel_definition env (mk_lid name) (U.abs effect_binders item None) in diff --git a/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst b/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst index e3f04680c3b..55d081e60f0 100644 --- a/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst +++ b/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst @@ -192,11 +192,6 @@ let solve_goals_with_tac env g (deferred_goals:implicits) (tac:sigelt) = | Sig_let {lids=[lid]} -> let qn = Env.lookup_qname env lid in let fv = S.lid_as_fv lid None in - let dd = - match Env.delta_depth_of_qninfo fv qn with - | Some dd -> dd - | None -> failwith "Expected a dd" - in let term = S.fv_to_tm (S.lid_as_fv lid None) in term | _ -> failwith "Resolve_tac not found" diff --git a/src/typechecker/FStar.TypeChecker.Env.fst b/src/typechecker/FStar.TypeChecker.Env.fst index c59d0cc38e8..49f46098a08 100644 --- a/src/typechecker/FStar.TypeChecker.Env.fst +++ b/src/typechecker/FStar.TypeChecker.Env.fst @@ -773,96 +773,112 @@ let lookup_definition delta_levels env lid = let lookup_nonrec_definition delta_levels env lid = lookup_definition_qninfo_aux false delta_levels lid <| lookup_qname env lid -let delta_depth_of_qninfo_lid lid (qn:qninfo) : option delta_depth = - match qn with - | None - | Some (Inl _, _) -> Some (Delta_constant_at_level 0) - | Some (Inr(se, _), _) -> - match se.sigel with - | Sig_inductive_typ _ - | Sig_bundle _ - | Sig_datacon _ -> Some (Delta_constant_at_level 0) - | Sig_declare_typ _ -> Some (FStar.Syntax.DsEnv.delta_depth_of_declaration lid se.sigquals) - | Sig_let {lbs=(_,lbs)} -> - BU.find_map lbs (fun lb -> - let fv = right lb.lbname in - if fv_eq_lid fv lid - then fv.fv_delta - else None) - - | Sig_fail _ - | Sig_splice _ -> - failwith "impossible: delta_depth_of_qninfo" - - | Sig_assume _ - | Sig_new_effect _ - | Sig_sub_effect _ - | Sig_effect_abbrev _ (* None? *) - | Sig_pragma _ - | Sig_polymonadic_bind _ - | Sig_polymonadic_subcomp _ -> None - - -// -// For the following prims symbols, -// delta depth is handled specially -// Instead of looking it up in the env, -// we return as is set in the input fv.fv_delta -// No principled reason, for backward compatibility -// -let prims_dd_lids = [ - Const.and_lid; - Const.or_lid; - Const.imp_lid; - Const.iff_lid; - Const.true_lid; - Const.false_lid; - Const.not_lid; - Const.b2t_lid; - Const.eq2_lid; - Const.eq3_lid; - Const.op_Eq; - Const.op_LT; - Const.op_LTE; - Const.op_GT; - Const.op_GTE; - Const.forall_lid; - Const.exists_lid; - Const.haseq_lid; - Const.op_And; - Const.op_Or; - Const.op_Negation; -] - -let is_prims_dd_lid (l:lident) = - List.existsb (fun l0 -> lid_equals l l0) prims_dd_lids - -let delta_depth_of_qninfo (fv:fv) (qn:qninfo) : option delta_depth = - let lid = fv.fv_name.v in - if is_prims_dd_lid lid && Some? fv.fv_delta - then fv.fv_delta //NS delta: too many special cases in existing code - else delta_depth_of_qninfo_lid lid qn - -let delta_depth_of_fv env fv = +let rec delta_depth_of_qninfo_lid env lid (qn:qninfo) : delta_depth = + match qn with + | None + | Some (Inl _, _) -> delta_constant + | Some (Inr(se, _), _) -> + match se.sigel with + | Sig_inductive_typ _ + | Sig_bundle _ + | Sig_datacon _ -> delta_constant + + | Sig_declare_typ _ -> + let d0 = + if U.is_primop_lid lid + then delta_equational + else delta_constant + in + if se.sigquals |> BU.for_some (Assumption?) + && not (se.sigquals |> BU.for_some (New?)) + then Delta_abstract d0 + else d0 + + | Sig_let {lbs=(_,lbs)} -> + BU.find_map lbs (fun lb -> + let fv = right lb.lbname in + if fv_eq_lid fv lid then + Some (incr_delta_depth <| delta_depth_of_term env lb.lbdef) + else None) |> must + + | Sig_fail _ + | Sig_splice _ -> + failwith "impossible: delta_depth_of_qninfo" + + | Sig_assume _ + | Sig_new_effect _ + | Sig_sub_effect _ + | Sig_effect_abbrev _ (* None? *) + | Sig_pragma _ + | Sig_polymonadic_bind _ + | Sig_polymonadic_subcomp _ -> + delta_constant + +and delta_depth_of_qninfo env (fv:fv) (qn:qninfo) : delta_depth = + delta_depth_of_qninfo_lid env fv.fv_name.v qn + +(* Computes the canonical delta_depth of a given fvar, by looking at its +definition (and recursing) if needed. Results are memoized in the env. + +NB: The cache is never invalidated. A potential problem here would be +if we memoize the delta_depth of a `val` before seeing the corresponding +`let`, but I don't think that can happen. Before seeing the `let`, other code +cannot refer to the name. *) +and delta_depth_of_fv (env:env) (fv:S.fv) : delta_depth = let lid = fv.fv_name.v in - if is_prims_dd_lid lid && Some? fv.fv_delta - then fv.fv_delta |> must - else - //try cache - (string_of_lid lid) |> BU.smap_try_find env.fv_delta_depths |> (fun d_opt -> - if d_opt |> is_some then d_opt |> must - else - match delta_depth_of_qninfo fv (lookup_qname env fv.fv_name.v) with - | None -> failwith (BU.format1 "Delta depth not found for %s" (FStar.Syntax.Print.fv_to_string fv)) - | Some d -> - if Some? fv.fv_delta && d <> Some?.v fv.fv_delta - && Options.debug_any() - then BU.print3 "WARNING WARNING WARNING fv=%s, delta_depth=%s, env.delta_depth=%s\n" - (Print.fv_to_string fv) - (show (Some?.v fv.fv_delta)) - (show d); - BU.smap_add env.fv_delta_depths (string_of_lid lid) d; - d) + (string_of_lid lid) |> BU.smap_try_find env.fv_delta_depths |> (function + | Some dd -> dd + | None -> + BU.smap_add env.fv_delta_depths (string_of_lid lid) delta_equational; + // ^ To prevent an infinite loop on recursive functions, we pre-seed the cache with + // a delta_equational. If we run into the same function while computing its delta_depth, + // we will return delta_equational. If not, we override the cache with the correct delta_depth. + let d = delta_depth_of_qninfo env fv (lookup_qname env fv.fv_name.v) in + // if Options.debug_any () then + // BU.print2_error "Memoizing delta_depth_of_fv %s ->\t%s\n" (show lid) (show d); + BU.smap_add env.fv_delta_depths (string_of_lid lid) d; + d) + +(* Computes the delta_depth of an fv, but taking into account the visibility +in the current module. *) +and fv_delta_depth (env:env) (fv:S.fv) : delta_depth = + let d = delta_depth_of_fv env fv in + match d with + | Delta_abstract (Delta_constant_at_level l) -> + if string_of_lid env.curmodule = nsstr fv.fv_name.v && not env.is_iface + //AR: TODO: this is to prevent unfolding of abstract symbols in the extracted interface + //a better way would be create new fvs with appripriate delta_depth at extraction time + then Delta_constant_at_level l //we're in the defining module + else delta_constant + | d -> d + +(* Computes the delta_depth of a term. This is the single way to compute it. *) +and delta_depth_of_term env t = + let t = U.unmeta t in + match t.n with + | Tm_meta _ + | Tm_delayed _ -> failwith "Impossible (delta depth of term)" + | Tm_lazy i -> delta_depth_of_term env (U.unfold_lazy i) + + | Tm_fvar fv -> fv_delta_depth env fv + + | Tm_bvar _ + | Tm_name _ + | Tm_match _ + | Tm_uvar _ + | Tm_unknown -> delta_equational + + | Tm_type _ + | Tm_quoted _ + | Tm_constant _ + | Tm_arrow _ -> delta_constant + + | Tm_uinst(t, _) + | Tm_refine {b={sort=t}} + | Tm_ascribed {tm=t} + | Tm_app {hd=t} + | Tm_abs {body=t} + | Tm_let {body=t} -> delta_depth_of_term env t let quals_of_qninfo (qninfo : qninfo) : option (list qualifier) = match qninfo with @@ -2026,11 +2042,6 @@ let get_letrec_arity (env:env) (lbname:lbname) : option int = let fvar_of_nonqual_lid env lid = let qn = lookup_qname env lid in - let dd = - match delta_depth_of_qninfo_lid lid qn with - | None -> failwith "Unexpected no delta_depth" - | Some dd -> dd - in fvar lid None let split_smt_query (e:env) (q:term) diff --git a/src/typechecker/FStar.TypeChecker.Env.fsti b/src/typechecker/FStar.TypeChecker.Env.fsti index f6d29b1ac6c..58283da8f44 100644 --- a/src/typechecker/FStar.TypeChecker.Env.fsti +++ b/src/typechecker/FStar.TypeChecker.Env.fsti @@ -344,7 +344,7 @@ val is_irreducible : env -> lident -> bool val is_type_constructor : env -> lident -> bool val num_inductive_ty_params: env -> lident -> option int val num_inductive_uniform_ty_params: env -> lident -> option int -val delta_depth_of_qninfo : fv -> qninfo -> option delta_depth +val delta_depth_of_qninfo : env -> fv -> qninfo -> delta_depth val delta_depth_of_fv : env -> fv -> delta_depth (* Universe instantiation *) @@ -546,3 +546,6 @@ instance val hasNames_lcomp : hasNames lcomp instance val pretty_lcomp : FStar.Class.PP.pretty lcomp instance val hasNames_guard : hasNames guard_t instance val pretty_guard : FStar.Class.PP.pretty guard_t + +val fv_delta_depth : env -> fv -> delta_depth +val delta_depth_of_term : env -> term -> delta_depth diff --git a/src/typechecker/FStar.TypeChecker.Normalize.fst b/src/typechecker/FStar.TypeChecker.Normalize.fst index 041692cef57..6cf52f982dc 100644 --- a/src/typechecker/FStar.TypeChecker.Normalize.fst +++ b/src/typechecker/FStar.TypeChecker.Normalize.fst @@ -1205,8 +1205,8 @@ let rec norm : cfg -> env -> stack -> term -> term = let lid = S.lid_of_fv fv in let qninfo = Env.lookup_qname cfg.tcenv lid in begin - match Env.delta_depth_of_qninfo fv qninfo with - | Some (Delta_constant_at_level 0) -> + match Env.delta_depth_of_qninfo cfg.tcenv fv qninfo with + | Delta_constant_at_level 0 -> log_unfolding cfg (fun () -> BU.print1 " >> This is a constant: %s\n" (Print.term_to_string t)); rebuild cfg empty_env stack t | _ -> diff --git a/src/typechecker/FStar.TypeChecker.Rel.fst b/src/typechecker/FStar.TypeChecker.Rel.fst index 2bd92dbf9e0..6088343ec11 100644 --- a/src/typechecker/FStar.TypeChecker.Rel.fst +++ b/src/typechecker/FStar.TypeChecker.Rel.fst @@ -1252,45 +1252,6 @@ let head_match = function | HeadMatch true -> HeadMatch true | _ -> HeadMatch false -let fv_delta_depth env fv = - let d = Env.delta_depth_of_fv env fv in - match d with - | Delta_abstract d -> - if string_of_lid env.curmodule = nsstr fv.fv_name.v && not env.is_iface //AR: TODO: this is to prevent unfolding of abstract symbols in the extracted interface - // a better way would be create new fvs with appripriate delta_depth at extraction time - then d //we're in the defining module - else delta_constant - | Delta_constant_at_level i when i > 0 -> - begin match Env.lookup_definition [Unfold delta_constant] env fv.fv_name.v with - | None -> delta_constant //there's no definition to unfold, e.g., because it's marked irreducible - | _ -> d - end - | d -> - d - -let rec delta_depth_of_term env t = - let t = U.unmeta t in - match t.n with - | Tm_meta _ - | Tm_delayed _ -> failwith "Impossible (delta depth of term)" - | Tm_lazy i -> delta_depth_of_term env (U.unfold_lazy i) - | Tm_unknown - | Tm_bvar _ - | Tm_name _ - | Tm_uvar _ - | Tm_let _ - | Tm_match _ -> None - | Tm_uinst(t, _) - | Tm_ascribed {tm=t} - | Tm_app {hd=t} - | Tm_refine {b={sort=t}} -> delta_depth_of_term env t - | Tm_constant _ - | Tm_type _ - | Tm_arrow _ - | Tm_quoted _ - | Tm_abs _ -> Some delta_constant - | Tm_fvar fv -> Some (fv_delta_depth env fv) - let universe_has_max env u = let u = N.normalize_universe env u in match u with @@ -1340,7 +1301,21 @@ let rec head_matches env t1 t2 : match_result = | Tm_quoted _, Tm_quoted _ | Tm_abs _, Tm_abs _ -> HeadMatch true - | _ -> MisMatch(delta_depth_of_term env t1, delta_depth_of_term env t2) + | _ -> + (* GM: I am retaining this logic here. I think it is meant to disable + unfolding of possibly-equational terms. This probably deserves a rework now + with the .logical field. *) + let maybe_dd (t:term) : option delta_depth = + match (SS.compress t).n with + | Tm_unknown + | Tm_bvar _ + | Tm_name _ + | Tm_uvar _ + | Tm_let _ + | Tm_match _ -> None + | _ -> Some (delta_depth_of_term env t) + in + MisMatch (maybe_dd t1, maybe_dd t2) (* Does t1 head-match t2, after some delta steps? *) let head_matches_delta env (logical:bool) smt_ok t1 t2 : (match_result & option (typ&typ)) = @@ -3552,11 +3527,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = | _ -> solve_sub_probs env wl //fallback to trying to solve with SMT on in - let d = - match delta_depth_of_term env head1 with - | None -> None - | Some d -> decr_delta_depth d - in + let d = decr_delta_depth <| delta_depth_of_term env head1 in let treat_as_injective = match (U.un_uinst head1).n with | Tm_fvar fv -> @@ -3873,14 +3844,9 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = solve (solve_prob orig (Some guard) [] wl) else giveup wl (mklstr (fun () -> BU.format4 "head mismatch (%s (%s) vs %s (%s))" (show head1) - (BU.dflt "" - (BU.bind_opt (delta_depth_of_term wl.tcenv head1) - (fun x -> Some (show x)))) + (show (delta_depth_of_term wl.tcenv head1)) (show head2) - (BU.dflt "" - (BU.bind_opt (delta_depth_of_term wl.tcenv head2) - (fun x -> Some (show x)))) - )) orig + (show (delta_depth_of_term wl.tcenv head2)))) orig end | (HeadMatch true, _) when problem.relation <> EQ -> diff --git a/src/typechecker/FStar.TypeChecker.Tc.fst b/src/typechecker/FStar.TypeChecker.Tc.fst index 05848497571..a8058c5269e 100644 --- a/src/typechecker/FStar.TypeChecker.Tc.fst +++ b/src/typechecker/FStar.TypeChecker.Tc.fst @@ -1008,6 +1008,31 @@ let tc_decls env ses = // Compress all checked sigelts. Uvars and names are not OK after a full typecheck let ses' = ses' |> List.map (Compress.deep_compress_se false false) in + // Make sure to update all the delta_depths of the definitions we will add to the + // environment. These can change if the body of the letbinding is transformed by any means, + // such as by resolving an `_ by ...`, or a pre/post process hook. + // let fixup_dd_lb (lb:letbinding) : letbinding = + // (* The delta depth of the fv is 1 + the dd of its body *) + // let Inr fv = lb.lbname in + // // BU.print2_error "Checking depth of %s = %s\n" (show lb.lbname) (show fv.fv_delta); + // // let dd = incr_delta_depth <| delta_qualifier lb.lbdef in + // let dd = incr_delta_depth <| delta_depth_of_term env lb.lbdef in + // // if Some dd <> fv.fv_delta then ( + // // BU.print3_error "Fixing up delta depth of %s from %s to %s\n" (Print.lbname_to_string lb.lbname) (show fv.fv_delta) (show dd) + // // ); + // // BU.print1_error "Definition = (%s)\n\n" (show lb.lbdef); + // let fv = { fv with fv_delta = Some dd } in + // { lb with lbname = Inr fv } + // in + // let fixup_delta_depth (se:sigelt) : sigelt = + // match se.sigel with + // | Sig_let {lbs; lids} -> + // let lbs = fst lbs, List.map fixup_dd_lb (snd lbs) in + // { se with sigel = Sig_let {lbs; lids} } + // | _ -> se + // in + // let ses' = ses' |> List.map fixup_delta_depth in + // Add to the environment let env = ses' |> List.fold_left (fun env se -> add_sigelt_to_env env se false) env in UF.reset(); diff --git a/src/typechecker/FStar.TypeChecker.TcInductive.fst b/src/typechecker/FStar.TypeChecker.TcInductive.fst index f4c6c9baffe..bf4578b6073 100644 --- a/src/typechecker/FStar.TypeChecker.TcInductive.fst +++ b/src/typechecker/FStar.TypeChecker.TcInductive.fst @@ -914,7 +914,7 @@ let mk_discriminator_and_indexed_projectors iquals (* Qualifie else let disc_name = U.mk_discriminator lid in let x = S.new_bv (Some p) arg_typ in let sort = - let disc_fvar = S.fvar_with_dd (Ident.set_lid_range disc_name p) (Delta_equational_at_level 1) None in + let disc_fvar = S.fvar_with_dd (Ident.set_lid_range disc_name p) None in U.refine x (U.b2t (S.mk_Tm_app (S.mk_Tm_uinst disc_fvar inst_univs) [as_arg <| S.bv_to_name x] p)) in S.mk_binder ({projectee arg_typ with sort = sort}) @@ -991,11 +991,10 @@ let mk_discriminator_and_indexed_projectors iquals (* Qualifie brs=[U.branch pat_true ; U.branch pat_false]; rc_opt=None}) p in - let dd = Delta_equational_at_level 1 in let imp = U.abs binders body None in let lbtyp = if no_decl then t else tun in let lb = U.mk_letbinding - (Inr (S.lid_and_dd_as_fv discriminator_name dd None)) + (Inr (S.lid_and_dd_as_fv discriminator_name None)) uvs lbtyp C.effect_Tot_lid @@ -1104,7 +1103,7 @@ let mk_discriminator_and_indexed_projectors iquals (* Qualifie let dd = Delta_equational_at_level 1 in let lbtyp = if no_decl then t else tun in let lb = { - lbname=Inr (S.lid_and_dd_as_fv field_name dd None); + lbname=Inr (S.lid_and_dd_as_fv field_name None); lbunivs=uvs; lbtyp=lbtyp; lbeff=C.effect_Tot_lid; From a1e37d56c091eb1a0bd15363461fa2eab5baf6cf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 26 Apr 2024 10:38:07 -0700 Subject: [PATCH 117/239] Update test + expected output The unifier will now try to subtype the unit into False via a query, instead of failing outright. Also remove duplicate in micro-benchmarks, we check the correctness of the tests here too. --- .../NegativeTests.ZZImplicitFalse.fst | 6 +++--- ...NegativeTests.ZZImplicitFalse.fst.expected | 15 +++++++------- .../NegativeTests.ZZImplicitFalse.fst | 20 ------------------- .../NegativeTests.ZZImplicitFalse.fst.hints | 1 - 4 files changed, 10 insertions(+), 32 deletions(-) delete mode 100644 tests/micro-benchmarks/NegativeTests.ZZImplicitFalse.fst delete mode 100644 tests/micro-benchmarks/NegativeTests.ZZImplicitFalse.fst.hints diff --git a/tests/error-messages/NegativeTests.ZZImplicitFalse.fst b/tests/error-messages/NegativeTests.ZZImplicitFalse.fst index 6ae82c4e5f5..fafa14e9a8a 100644 --- a/tests/error-messages/NegativeTests.ZZImplicitFalse.fst +++ b/tests/error-messages/NegativeTests.ZZImplicitFalse.fst @@ -15,6 +15,6 @@ *) module NegativeTests.ZZImplicitFalse -val wtf: unit -> Lemma False -[@@ expect_failure] // error 19 (assertion failed) on 1-phase, error 66 (failed to resolve impl) on 2-phase -let wtf _ = let _:False = _ in () +val test : unit -> Lemma False +[@@expect_failure [19]] +let test _ = let _:False = _ in () diff --git a/tests/error-messages/NegativeTests.ZZImplicitFalse.fst.expected b/tests/error-messages/NegativeTests.ZZImplicitFalse.fst.expected index 403572a03fb..cf9a8d8e810 100644 --- a/tests/error-messages/NegativeTests.ZZImplicitFalse.fst.expected +++ b/tests/error-messages/NegativeTests.ZZImplicitFalse.fst.expected @@ -1,14 +1,13 @@ >> Got issues: [ -* Error 66 at NegativeTests.ZZImplicitFalse.fst(20,26-20,27): - - Failed to resolve implicit argument ?1 - of type Prims.l_False - introduced for - user-provided implicit term at - NegativeTests.ZZImplicitFalse.fst(20,26-20,27) +* Error 19 at NegativeTests.ZZImplicitFalse.fst(20,27-20,28): + - Subtyping check failed; expected type Prims.l_False; got type Prims.unit + - The SMT solver could not prove the query. Use --query_stats for more + details. + - See also prims.fst(138,29-138,34) >>] -* Warning 240 at NegativeTests.ZZImplicitFalse.fst(18,4-18,7): - - NegativeTests.ZZImplicitFalse.wtf is declared but no definition was found +* Warning 240 at NegativeTests.ZZImplicitFalse.fst(18,4-18,8): + - NegativeTests.ZZImplicitFalse.test is declared but no definition was found - Add an 'assume' if this is intentional Verified module: NegativeTests.ZZImplicitFalse diff --git a/tests/micro-benchmarks/NegativeTests.ZZImplicitFalse.fst b/tests/micro-benchmarks/NegativeTests.ZZImplicitFalse.fst deleted file mode 100644 index 6ae82c4e5f5..00000000000 --- a/tests/micro-benchmarks/NegativeTests.ZZImplicitFalse.fst +++ /dev/null @@ -1,20 +0,0 @@ -(* - Copyright 2008-2018 Microsoft Research - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. -*) -module NegativeTests.ZZImplicitFalse - -val wtf: unit -> Lemma False -[@@ expect_failure] // error 19 (assertion failed) on 1-phase, error 66 (failed to resolve impl) on 2-phase -let wtf _ = let _:False = _ in () diff --git a/tests/micro-benchmarks/NegativeTests.ZZImplicitFalse.fst.hints b/tests/micro-benchmarks/NegativeTests.ZZImplicitFalse.fst.hints deleted file mode 100644 index d3004c945c7..00000000000 --- a/tests/micro-benchmarks/NegativeTests.ZZImplicitFalse.fst.hints +++ /dev/null @@ -1 +0,0 @@ -[ "7i¨\u001cË\u0007\u0002Ë\nì*}éwC?", [] ] \ No newline at end of file From 8062c68337c128dbd8484ee6ff9bed3a677669a8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 25 Apr 2024 15:41:01 -0700 Subject: [PATCH 118/239] snap --- .../generated/FStar_Extraction_ML_Term.ml | 4 +- .../generated/FStar_SquashProperties.ml | 2 +- .../fstar-lib/generated/FStar_Syntax_DsEnv.ml | 142 +-- .../generated/FStar_Syntax_Resugar.ml | 29 +- .../fstar-lib/generated/FStar_Syntax_Subst.ml | 2 - .../generated/FStar_Syntax_Syntax.ml | 58 +- .../fstar-lib/generated/FStar_Syntax_Util.ml | 73 +- .../generated/FStar_Tactics_Hooks.ml | 27 +- .../generated/FStar_ToSyntax_ToSyntax.ml | 159 +-- .../generated/FStar_TypeChecker_Common.ml | 28 +- .../generated/FStar_TypeChecker_Core.ml | 41 +- .../generated/FStar_TypeChecker_DMFF.ml | 35 +- .../FStar_TypeChecker_DeferredImplicits.ml | 7 - .../generated/FStar_TypeChecker_Env.ml | 330 ++++--- .../generated/FStar_TypeChecker_Normalize.ml | 28 +- .../FStar_TypeChecker_PatternUtils.ml | 5 +- .../generated/FStar_TypeChecker_Rel.ml | 919 ++++++++++-------- .../FStar_TypeChecker_TcInductive.ml | 9 +- .../generated/FStar_TypeChecker_TcTerm.ml | 187 ++-- 19 files changed, 932 insertions(+), 1153 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Extraction_ML_Term.ml b/ocaml/fstar-lib/generated/FStar_Extraction_ML_Term.ml index 674c7498edc..01396d86335 100644 --- a/ocaml/fstar-lib/generated/FStar_Extraction_ML_Term.ml +++ b/ocaml/fstar-lib/generated/FStar_Extraction_ML_Term.ml @@ -549,15 +549,13 @@ let (is_constructor : FStar_Syntax_Syntax.term -> Prims.bool) = match uu___ with | FStar_Syntax_Syntax.Tm_fvar { FStar_Syntax_Syntax.fv_name = uu___1; - FStar_Syntax_Syntax.fv_delta = uu___2; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Data_ctor);_} -> true | FStar_Syntax_Syntax.Tm_fvar { FStar_Syntax_Syntax.fv_name = uu___1; - FStar_Syntax_Syntax.fv_delta = uu___2; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Record_ctor uu___3);_} + (FStar_Syntax_Syntax.Record_ctor uu___2);_} -> true | uu___1 -> false let rec (is_fstar_value : FStar_Syntax_Syntax.term -> Prims.bool) = diff --git a/ocaml/fstar-lib/generated/FStar_SquashProperties.ml b/ocaml/fstar-lib/generated/FStar_SquashProperties.ml index 3675bae54de..141fc597d5b 100644 --- a/ocaml/fstar-lib/generated/FStar_SquashProperties.ml +++ b/ocaml/fstar-lib/generated/FStar_SquashProperties.ml @@ -11,6 +11,6 @@ type ('a, 'b) retract_cond = | MkC of unit * unit * unit let uu___is_MkC : 'a 'b . ('a, 'b) retract_cond -> Prims.bool = fun projectee -> true -let false_elim : 'a . Prims.l_False -> 'a = +let false_elim : 'a . unit -> 'a = fun uu___ -> (fun f -> Obj.magic (failwith "unreachable")) uu___ type u = unit \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml b/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml index 06ff38992f3..fde5d3782c3 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml @@ -51,9 +51,7 @@ let (ugly_sigelt_to_string : FStar_Syntax_Syntax.sigelt -> Prims.string) = uu___ se type local_binding = (FStar_Ident.ident * FStar_Syntax_Syntax.bv * used_marker) -type rec_binding = - (FStar_Ident.ident * FStar_Ident.lid * FStar_Syntax_Syntax.delta_depth * - used_marker) +type rec_binding = (FStar_Ident.ident * FStar_Ident.lid * used_marker) type scope_mod = | Local_binding of local_binding | Rec_binding of rec_binding @@ -642,13 +640,12 @@ let (bv_to_name : fun r -> let uu___ = set_bv_range bv r in FStar_Syntax_Syntax.bv_to_name uu___ let (unmangleMap : - (Prims.string * Prims.string * FStar_Syntax_Syntax.delta_depth * - FStar_Syntax_Syntax.fv_qual FStar_Pervasives_Native.option) Prims.list) + (Prims.string * Prims.string * FStar_Syntax_Syntax.fv_qual + FStar_Pervasives_Native.option) Prims.list) = - [("op_ColonColon", "Cons", FStar_Syntax_Syntax.delta_constant, + [("op_ColonColon", "Cons", (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor)); - ("not", "op_Negation", FStar_Syntax_Syntax.delta_equational, - FStar_Pervasives_Native.None)] + ("not", "op_Negation", FStar_Pervasives_Native.None)] let (unmangleOpName : FStar_Ident.ident -> FStar_Syntax_Syntax.term FStar_Pervasives_Native.option) @@ -657,7 +654,7 @@ let (unmangleOpName : FStar_Compiler_Util.find_map unmangleMap (fun uu___ -> match uu___ with - | (x, y, dd, dq) -> + | (x, y, dq) -> let uu___1 = let uu___2 = FStar_Ident.string_of_id id in uu___2 = x in if uu___1 @@ -666,7 +663,7 @@ let (unmangleOpName : let uu___3 = let uu___4 = FStar_Ident.range_of_id id in FStar_Ident.lid_of_path ["Prims"; y] uu___4 in - FStar_Syntax_Syntax.fvar_with_dd uu___3 dd dq in + FStar_Syntax_Syntax.fvar_with_dd uu___3 dq in FStar_Pervasives_Native.Some uu___2 else FStar_Pervasives_Native.None) type 'a cont_t = @@ -837,10 +834,10 @@ let try_lookup_id'' : uu___3 = uu___4 in let check_rec_binding_id uu___ = match uu___ with - | (id', uu___1, uu___2, uu___3) -> - let uu___4 = FStar_Ident.string_of_id id' in - let uu___5 = FStar_Ident.string_of_id id in - uu___4 = uu___5 in + | (id', uu___1, uu___2) -> + let uu___3 = FStar_Ident.string_of_id id' in + let uu___4 = FStar_Ident.string_of_id id in + uu___3 = uu___4 in let curmod_ns = let uu___ = current_module env1 in FStar_Ident.ids_of_lid uu___ in @@ -856,7 +853,7 @@ let try_lookup_id'' : | Rec_binding r when check_rec_binding_id r -> let uu___1 = r in (match uu___1 with - | (uu___2, uu___3, uu___4, used_marker1) -> + | (uu___2, uu___3, used_marker1) -> (FStar_Compiler_Effect.op_Colon_Equals used_marker1 true; k_rec_binding r)) @@ -1226,40 +1223,6 @@ let (ns_of_lid_equals : let uu___1 = FStar_Ident.ns_of_lid lid in FStar_Ident.lid_of_ids uu___1 in FStar_Ident.lid_equals uu___ ns) -let (delta_depth_of_declaration : - FStar_Ident.lident -> - FStar_Syntax_Syntax.qualifier Prims.list -> - FStar_Syntax_Syntax.delta_depth) - = - fun lid -> - fun quals -> - let dd = - let uu___ = - (FStar_Syntax_Util.is_primop_lid lid) || - (FStar_Compiler_Util.for_some - (fun uu___1 -> - match uu___1 with - | FStar_Syntax_Syntax.Projector uu___2 -> true - | FStar_Syntax_Syntax.Discriminator uu___2 -> true - | uu___2 -> false) quals) in - if uu___ - then FStar_Syntax_Syntax.delta_equational - else FStar_Syntax_Syntax.delta_constant in - let uu___ = - (FStar_Compiler_Util.for_some - (fun uu___1 -> - match uu___1 with - | FStar_Syntax_Syntax.Assumption -> true - | uu___2 -> false) quals) - && - (let uu___1 = - FStar_Compiler_Util.for_some - (fun uu___2 -> - match uu___2 with - | FStar_Syntax_Syntax.New -> true - | uu___3 -> false) quals in - Prims.op_Negation uu___1) in - if uu___ then FStar_Syntax_Syntax.Delta_abstract dd else dd let (try_lookup_name : Prims.bool -> Prims.bool -> @@ -1281,7 +1244,6 @@ let (try_lookup_name : let uu___4 = let uu___5 = FStar_Syntax_Syntax.fvar_with_dd source_lid - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in (uu___5, (se.FStar_Syntax_Syntax.sigattrs)) in Term_name uu___4 in @@ -1291,8 +1253,7 @@ let (try_lookup_name : let uu___4 = let uu___5 = let uu___6 = fv_qual_of_se se in - FStar_Syntax_Syntax.fvar_with_dd source_lid - FStar_Syntax_Syntax.delta_constant uu___6 in + FStar_Syntax_Syntax.fvar_with_dd source_lid uu___6 in (uu___5, (se.FStar_Syntax_Syntax.sigattrs)) in Term_name uu___4 in FStar_Pervasives_Native.Some uu___3 @@ -1304,10 +1265,7 @@ let (try_lookup_name : let uu___4 = let uu___5 = let uu___6 = - let uu___7 = - FStar_Compiler_Util.must - fv.FStar_Syntax_Syntax.fv_delta in - FStar_Syntax_Syntax.fvar_with_dd source_lid uu___7 + FStar_Syntax_Syntax.fvar_with_dd source_lid fv.FStar_Syntax_Syntax.fv_qual in (uu___6, (se.FStar_Syntax_Syntax.sigattrs)) in Term_name uu___5 in @@ -1330,7 +1288,6 @@ let (try_lookup_name : let lid2 = let uu___5 = FStar_Ident.range_of_lid source_lid in FStar_Ident.set_lid_range lid1 uu___5 in - let dd = delta_depth_of_declaration lid2 quals in let uu___5 = FStar_Compiler_Util.find_map quals (fun uu___6 -> @@ -1354,7 +1311,7 @@ let (try_lookup_name : let uu___8 = let uu___9 = let uu___10 = fv_qual_of_se se in - FStar_Syntax_Syntax.fvar_with_dd lid2 dd + FStar_Syntax_Syntax.fvar_with_dd lid2 uu___10 in (uu___9, (se.FStar_Syntax_Syntax.sigattrs)) in Term_name uu___8 in @@ -1381,8 +1338,7 @@ let (try_lookup_name : let uu___4 = let uu___5 = FStar_Syntax_Syntax.fvar_with_dd source_lid - (FStar_Syntax_Syntax.Delta_constant_at_level - Prims.int_one) FStar_Pervasives_Native.None in + FStar_Pervasives_Native.None in (uu___5, []) in Term_name uu___4 in FStar_Pervasives_Native.Some uu___3 @@ -1394,7 +1350,7 @@ let (try_lookup_name : FStar_Pervasives_Native.Some (Term_name (t, [])) in let k_rec_binding uu___ = match uu___ with - | (id, l, dd, used_marker1) -> + | (id, l, used_marker1) -> (FStar_Compiler_Effect.op_Colon_Equals used_marker1 true; (let uu___2 = let uu___3 = @@ -1402,7 +1358,7 @@ let (try_lookup_name : let uu___5 = let uu___6 = FStar_Ident.range_of_lid lid in FStar_Ident.set_lid_range l uu___6 in - FStar_Syntax_Syntax.fvar_with_dd uu___5 dd + FStar_Syntax_Syntax.fvar_with_dd uu___5 FStar_Pervasives_Native.None in (uu___4, []) in Term_name uu___3 in @@ -1646,9 +1602,7 @@ let (try_lookup_let : uu___9) -> let fv = lb_fv lbs lid1 in let uu___10 = - let uu___11 = - FStar_Compiler_Util.must fv.FStar_Syntax_Syntax.fv_delta in - FStar_Syntax_Syntax.fvar_with_dd lid1 uu___11 + FStar_Syntax_Syntax.fvar_with_dd lid1 fv.FStar_Syntax_Syntax.fv_qual in FStar_Pervasives_Native.Some uu___10 | uu___1 -> FStar_Pervasives_Native.None in @@ -1894,7 +1848,6 @@ let (try_lookup_datacon : then let uu___8 = FStar_Syntax_Syntax.lid_and_dd_as_fv lid1 - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in FStar_Pervasives_Native.Some uu___8 else FStar_Pervasives_Native.None @@ -1908,9 +1861,7 @@ let (try_lookup_datacon : FStar_Syntax_Syntax.sigopts = uu___6;_}, uu___7) -> let qual1 = fv_qual_of_se (FStar_Pervasives_Native.fst se) in - let uu___8 = - FStar_Syntax_Syntax.lid_and_dd_as_fv lid1 - FStar_Syntax_Syntax.delta_constant qual1 in + let uu___8 = FStar_Syntax_Syntax.lid_and_dd_as_fv lid1 qual1 in FStar_Pervasives_Native.Some uu___8 | ({ FStar_Syntax_Syntax.sigel = FStar_Syntax_Syntax.Sig_datacon @@ -1923,9 +1874,7 @@ let (try_lookup_datacon : FStar_Syntax_Syntax.sigopts = uu___6;_}, uu___7) -> let qual1 = fv_qual_of_se (FStar_Pervasives_Native.fst se) in - let uu___8 = - FStar_Syntax_Syntax.lid_and_dd_as_fv lid1 - FStar_Syntax_Syntax.delta_constant qual1 in + let uu___8 = FStar_Syntax_Syntax.lid_and_dd_as_fv lid1 qual1 in FStar_Pervasives_Native.Some uu___8 | uu___ -> FStar_Pervasives_Native.None in resolve_in_open_namespaces' env1 lid @@ -2439,30 +2388,25 @@ let (push_bv : env -> FStar_Ident.ident -> (env * FStar_Syntax_Syntax.bv)) = let uu___ = push_bv' env1 x in match uu___ with | (env2, bv, uu___1) -> (env2, bv) let (push_top_level_rec_binding : - env -> - FStar_Ident.ident -> - FStar_Syntax_Syntax.delta_depth -> - (env * Prims.bool FStar_Compiler_Effect.ref)) - = + env -> FStar_Ident.ident -> (env * Prims.bool FStar_Compiler_Effect.ref)) = fun env0 -> fun x -> - fun dd -> - let l = qualify env0 x in - let uu___ = - (unique false true env0 l) || (FStar_Options.interactive ()) in - if uu___ - then - let used_marker1 = FStar_Compiler_Util.mk_ref false in - ((push_scope_mod env0 (Rec_binding (x, l, dd, used_marker1))), - used_marker1) - else - (let uu___2 = - let uu___3 = - let uu___4 = FStar_Ident.string_of_lid l in - Prims.strcat "Duplicate top-level names " uu___4 in - (FStar_Errors_Codes.Fatal_DuplicateTopLevelNames, uu___3) in - let uu___3 = FStar_Ident.range_of_lid l in - FStar_Errors.raise_error uu___2 uu___3) + let l = qualify env0 x in + let uu___ = + (unique false true env0 l) || (FStar_Options.interactive ()) in + if uu___ + then + let used_marker1 = FStar_Compiler_Util.mk_ref false in + ((push_scope_mod env0 (Rec_binding (x, l, used_marker1))), + used_marker1) + else + (let uu___2 = + let uu___3 = + let uu___4 = FStar_Ident.string_of_lid l in + Prims.strcat "Duplicate top-level names " uu___4 in + (FStar_Errors_Codes.Fatal_DuplicateTopLevelNames, uu___3) in + let uu___3 = FStar_Ident.range_of_lid l in + FStar_Errors.raise_error uu___2 uu___3) let (push_sigelt' : Prims.bool -> env -> FStar_Syntax_Syntax.sigelt -> env) = fun fail_on_dup -> fun env1 -> @@ -3605,11 +3549,9 @@ let (resolve_name : FStar_Pervasives_Native.Some (FStar_Pervasives.Inr fv) | uu___2 -> FStar_Pervasives_Native.None) | FStar_Pervasives_Native.Some (Eff_name (se, l)) -> - let uu___1 = delta_depth_of_declaration in - let uu___2 = - let uu___3 = + let uu___1 = + let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv l - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in - FStar_Pervasives.Inr uu___3 in - FStar_Pervasives_Native.Some uu___2 \ No newline at end of file + FStar_Pervasives.Inr uu___2 in + FStar_Pervasives_Native.Some uu___1 \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml index d9ea812baef..32baefc20fd 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml @@ -2198,41 +2198,40 @@ and (resugar_pat' : mk (FStar_Parser_AST.PatTuple (args1, is_dependent_tuple)) | FStar_Syntax_Syntax.Pat_cons ({ FStar_Syntax_Syntax.fv_name = uu___; - FStar_Syntax_Syntax.fv_delta = uu___1; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor (name, fields));_}, - uu___2, args) + uu___1, args) -> let fields1 = - let uu___3 = + let uu___2 = FStar_Compiler_List.map (fun f -> FStar_Ident.lid_of_ids [f]) fields in - FStar_Compiler_List.rev uu___3 in + FStar_Compiler_List.rev uu___2 in let args1 = - let uu___3 = + let uu___2 = FStar_Compiler_List.map - (fun uu___4 -> - match uu___4 with + (fun uu___3 -> + match uu___3 with | (p2, b) -> aux p2 (FStar_Pervasives_Native.Some b)) args in - FStar_Compiler_List.rev uu___3 in + FStar_Compiler_List.rev uu___2 in let rec map2 l1 l2 = match (l1, l2) with | ([], []) -> [] | ([], hd::tl) -> [] | (hd::tl, []) -> - let uu___3 = - let uu___4 = + let uu___2 = + let uu___3 = mk (FStar_Parser_AST.PatWild (FStar_Pervasives_Native.None, [])) in - (hd, uu___4) in - let uu___4 = map2 tl [] in uu___3 :: uu___4 + (hd, uu___3) in + let uu___3 = map2 tl [] in uu___2 :: uu___3 | (hd1::tl1, hd2::tl2) -> - let uu___3 = map2 tl1 tl2 in (hd1, hd2) :: uu___3 in + let uu___2 = map2 tl1 tl2 in (hd1, hd2) :: uu___2 in let args2 = - let uu___3 = map2 fields1 args1 in - FStar_Compiler_List.rev uu___3 in + let uu___2 = map2 fields1 args1 in + FStar_Compiler_List.rev uu___2 in mk (FStar_Parser_AST.PatRecord args2) | FStar_Syntax_Syntax.Pat_cons (fv, uu___, args) -> resugar_plain_pat_cons fv args diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Subst.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Subst.ml index 0ade76e6491..2a4e8ae9518 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Subst.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Subst.ml @@ -263,8 +263,6 @@ let tag_with_range : let fv1 = { FStar_Syntax_Syntax.fv_name = v; - FStar_Syntax_Syntax.fv_delta = - (fv.FStar_Syntax_Syntax.fv_delta); FStar_Syntax_Syntax.fv_qual = (fv.FStar_Syntax_Syntax.fv_qual) } in diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml index 35276ce22c0..f7b8282b893 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml @@ -376,10 +376,8 @@ and bv = { ppname: FStar_Ident.ident ; index: Prims.int ; sort: term' syntax } -and fv = - { +and fv = { fv_name: var ; - fv_delta: delta_depth FStar_Pervasives_Native.option ; fv_qual: fv_qual FStar_Pervasives_Native.option } and free_vars = { @@ -970,18 +968,11 @@ let (__proj__Mkbv__item__sort : bv -> term' syntax) = fun projectee -> match projectee with | { ppname; index; sort;_} -> sort let (__proj__Mkfv__item__fv_name : fv -> var) = fun projectee -> - match projectee with - | { fv_name; fv_delta; fv_qual = fv_qual1;_} -> fv_name -let (__proj__Mkfv__item__fv_delta : - fv -> delta_depth FStar_Pervasives_Native.option) = - fun projectee -> - match projectee with - | { fv_name; fv_delta; fv_qual = fv_qual1;_} -> fv_delta + match projectee with | { fv_name; fv_qual = fv_qual1;_} -> fv_name let (__proj__Mkfv__item__fv_qual : fv -> fv_qual FStar_Pervasives_Native.option) = fun projectee -> - match projectee with - | { fv_name; fv_delta; fv_qual = fv_qual1;_} -> fv_qual1 + match projectee with | { fv_name; fv_qual = fv_qual1;_} -> fv_qual1 let (__proj__Mkfree_vars__item__free_names : free_vars -> bv Prims.list) = fun projectee -> match projectee with @@ -2678,41 +2669,26 @@ let (set_bv_range : bv -> FStar_Compiler_Range_Type.range -> bv) = let uu___ = FStar_Ident.set_id_range r bv1.ppname in { ppname = uu___; index = (bv1.index); sort = (bv1.sort) } let (lid_and_dd_as_fv : - FStar_Ident.lident -> - delta_depth -> fv_qual FStar_Pervasives_Native.option -> fv) - = + FStar_Ident.lident -> fv_qual FStar_Pervasives_Native.option -> fv) = fun l -> - fun dd -> - fun dq -> - let uu___ = - let uu___1 = FStar_Ident.range_of_lid l in withinfo l uu___1 in - { - fv_name = uu___; - fv_delta = (FStar_Pervasives_Native.Some dd); - fv_qual = dq - } + fun dq -> + let uu___ = + let uu___1 = FStar_Ident.range_of_lid l in withinfo l uu___1 in + { fv_name = uu___; fv_qual = dq } let (lid_as_fv : FStar_Ident.lident -> fv_qual FStar_Pervasives_Native.option -> fv) = fun l -> fun dq -> let uu___ = let uu___1 = FStar_Ident.range_of_lid l in withinfo l uu___1 in - { - fv_name = uu___; - fv_delta = FStar_Pervasives_Native.None; - fv_qual = dq - } + { fv_name = uu___; fv_qual = dq } let (fv_to_tm : fv -> term) = fun fv1 -> let uu___ = FStar_Ident.range_of_lid (fv1.fv_name).v in mk (Tm_fvar fv1) uu___ let (fvar_with_dd : - FStar_Ident.lident -> - delta_depth -> fv_qual FStar_Pervasives_Native.option -> term) - = - fun l -> - fun dd -> - fun dq -> let uu___ = lid_and_dd_as_fv l dd dq in fv_to_tm uu___ + FStar_Ident.lident -> fv_qual FStar_Pervasives_Native.option -> term) = + fun l -> fun dq -> let uu___ = lid_and_dd_as_fv l dq in fv_to_tm uu___ let (fvar : FStar_Ident.lident -> fv_qual FStar_Pervasives_Native.option -> term) = fun l -> fun dq -> let uu___ = lid_as_fv l dq in fv_to_tm uu___ @@ -2727,7 +2703,7 @@ let (set_range_of_fv : fv -> FStar_Compiler_Range_Type.range -> fv) = let uu___2 = let uu___3 = lid_of_fv fv1 in FStar_Ident.set_lid_range uu___3 r in { v = uu___2; p = (uu___1.p) } in - { fv_name = uu___; fv_delta = (fv1.fv_delta); fv_qual = (fv1.fv_qual) } + { fv_name = uu___; fv_qual = (fv1.fv_qual) } let (has_simple_attribute : term Prims.list -> Prims.string -> Prims.bool) = fun l -> fun s -> @@ -2773,7 +2749,7 @@ let (delta_constant : delta_depth) = Delta_constant_at_level Prims.int_zero let (delta_equational : delta_depth) = Delta_equational_at_level Prims.int_zero let (fvconst : FStar_Ident.lident -> fv) = - fun l -> lid_and_dd_as_fv l delta_constant FStar_Pervasives_Native.None + fun l -> lid_and_dd_as_fv l FStar_Pervasives_Native.None let (tconst : FStar_Ident.lident -> term) = fun l -> let uu___ = let uu___1 = fvconst l in Tm_fvar uu___1 in @@ -2781,16 +2757,12 @@ let (tconst : FStar_Ident.lident -> term) = let (tabbrev : FStar_Ident.lident -> term) = fun l -> let uu___ = - let uu___1 = - lid_and_dd_as_fv l (Delta_constant_at_level Prims.int_one) - FStar_Pervasives_Native.None in + let uu___1 = lid_and_dd_as_fv l FStar_Pervasives_Native.None in Tm_fvar uu___1 in mk uu___ FStar_Compiler_Range_Type.dummyRange let (tdataconstr : FStar_Ident.lident -> term) = fun l -> - let uu___ = - lid_and_dd_as_fv l delta_constant - (FStar_Pervasives_Native.Some Data_ctor) in + let uu___ = lid_and_dd_as_fv l (FStar_Pervasives_Native.Some Data_ctor) in fv_to_tm uu___ let (t_unit : term) = tconst FStar_Parser_Const.unit_lid let (t_bool : term) = tconst FStar_Parser_Const.bool_lid diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml index 7ddadaffc7d..20d9ecd64ad 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml @@ -2382,18 +2382,14 @@ let (exp_string : Prims.string -> FStar_Syntax_Syntax.term) = (FStar_Const.Const_string (s, FStar_Compiler_Range_Type.dummyRange))) FStar_Compiler_Range_Type.dummyRange let (fvar_const : FStar_Ident.lident -> FStar_Syntax_Syntax.term) = - fun l -> - FStar_Syntax_Syntax.fvar_with_dd l FStar_Syntax_Syntax.delta_constant - FStar_Pervasives_Native.None + fun l -> FStar_Syntax_Syntax.fvar_with_dd l FStar_Pervasives_Native.None let (tand : FStar_Syntax_Syntax.term) = fvar_const FStar_Parser_Const.and_lid let (tor : FStar_Syntax_Syntax.term) = fvar_const FStar_Parser_Const.or_lid let (timp : FStar_Syntax_Syntax.term) = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.imp_lid - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) FStar_Pervasives_Native.None let (tiff : FStar_Syntax_Syntax.term) = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.iff_lid - (FStar_Syntax_Syntax.Delta_constant_at_level (Prims.of_int (2))) FStar_Pervasives_Native.None let (t_bool : FStar_Syntax_Syntax.term) = fvar_const FStar_Parser_Const.bool_lid @@ -2500,7 +2496,7 @@ let (mk_conj_l : match phi with | [] -> FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.true_lid - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None + FStar_Pervasives_Native.None | hd::tl -> FStar_Compiler_List.fold_right mk_conj tl hd let (mk_disj : FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> @@ -2705,15 +2701,13 @@ let (mk_has_type : FStar_Syntax_Syntax.mk uu___ FStar_Compiler_Range_Type.dummyRange let (tforall : FStar_Syntax_Syntax.term) = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.forall_lid - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) FStar_Pervasives_Native.None let (texists : FStar_Syntax_Syntax.term) = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.exists_lid - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) FStar_Pervasives_Native.None let (t_haseq : FStar_Syntax_Syntax.term) = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.haseq_lid - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None + FStar_Pervasives_Native.None let (decidable_eq : FStar_Syntax_Syntax.term) = fvar_const FStar_Parser_Const.op_Eq let (mk_decidable_eq : @@ -2994,7 +2988,6 @@ let (mk_squash : fun p -> let sq = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.squash_lid - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) FStar_Pervasives_Native.None in let uu___ = FStar_Syntax_Syntax.mk_Tm_uinst sq [u] in let uu___1 = let uu___2 = FStar_Syntax_Syntax.as_arg p in [uu___2] in @@ -3008,7 +3001,6 @@ let (mk_auto_squash : fun p -> let sq = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.auto_squash_lid - (FStar_Syntax_Syntax.Delta_constant_at_level (Prims.of_int (2))) FStar_Pervasives_Native.None in let uu___ = FStar_Syntax_Syntax.mk_Tm_uinst sq [u] in let uu___1 = let uu___2 = FStar_Syntax_Syntax.as_arg p in [uu___2] in @@ -3247,7 +3239,6 @@ let (action_as_lb : let uu___1 = FStar_Syntax_Syntax.lid_and_dd_as_fv a.FStar_Syntax_Syntax.action_name - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Pervasives.Inr uu___1 in let uu___1 = @@ -3319,61 +3310,6 @@ let (mk_reflect : } in FStar_Syntax_Syntax.Tm_app uu___1 in FStar_Syntax_Syntax.mk uu___ t.FStar_Syntax_Syntax.pos -let rec (delta_qualifier : - FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.delta_depth) = - fun t -> - let t1 = FStar_Syntax_Subst.compress t in - match t1.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_delayed uu___ -> - FStar_Compiler_Effect.failwith "Impossible" - | FStar_Syntax_Syntax.Tm_lazy i -> - let uu___ = unfold_lazy i in delta_qualifier uu___ - | FStar_Syntax_Syntax.Tm_fvar fv -> - (match fv.FStar_Syntax_Syntax.fv_delta with - | FStar_Pervasives_Native.Some d -> d - | FStar_Pervasives_Native.None -> FStar_Syntax_Syntax.delta_constant) - | FStar_Syntax_Syntax.Tm_bvar uu___ -> - FStar_Syntax_Syntax.delta_equational - | FStar_Syntax_Syntax.Tm_name uu___ -> - FStar_Syntax_Syntax.delta_equational - | FStar_Syntax_Syntax.Tm_match uu___ -> - FStar_Syntax_Syntax.delta_equational - | FStar_Syntax_Syntax.Tm_uvar uu___ -> - FStar_Syntax_Syntax.delta_equational - | FStar_Syntax_Syntax.Tm_unknown -> FStar_Syntax_Syntax.delta_equational - | FStar_Syntax_Syntax.Tm_type uu___ -> FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Tm_quoted uu___ -> - FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Tm_constant uu___ -> - FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Tm_arrow uu___ -> - FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Tm_uinst (t2, uu___) -> delta_qualifier t2 - | FStar_Syntax_Syntax.Tm_refine - { - FStar_Syntax_Syntax.b = - { FStar_Syntax_Syntax.ppname = uu___; - FStar_Syntax_Syntax.index = uu___1; - FStar_Syntax_Syntax.sort = t2;_}; - FStar_Syntax_Syntax.phi = uu___2;_} - -> delta_qualifier t2 - | FStar_Syntax_Syntax.Tm_meta - { FStar_Syntax_Syntax.tm2 = t2; FStar_Syntax_Syntax.meta = uu___;_} - -> delta_qualifier t2 - | FStar_Syntax_Syntax.Tm_ascribed - { FStar_Syntax_Syntax.tm = t2; FStar_Syntax_Syntax.asc = uu___; - FStar_Syntax_Syntax.eff_opt = uu___1;_} - -> delta_qualifier t2 - | FStar_Syntax_Syntax.Tm_app - { FStar_Syntax_Syntax.hd = t2; FStar_Syntax_Syntax.args = uu___;_} -> - delta_qualifier t2 - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = uu___; FStar_Syntax_Syntax.body = t2; - FStar_Syntax_Syntax.rc_opt = uu___1;_} - -> delta_qualifier t2 - | FStar_Syntax_Syntax.Tm_let - { FStar_Syntax_Syntax.lbs = uu___; FStar_Syntax_Syntax.body1 = t2;_} - -> delta_qualifier t2 let rec (incr_delta_depth : FStar_Syntax_Syntax.delta_depth -> FStar_Syntax_Syntax.delta_depth) = fun d -> @@ -3383,9 +3319,6 @@ let rec (incr_delta_depth : | FStar_Syntax_Syntax.Delta_equational_at_level i -> FStar_Syntax_Syntax.Delta_equational_at_level (i + Prims.int_one) | FStar_Syntax_Syntax.Delta_abstract d1 -> incr_delta_depth d1 -let (incr_delta_qualifier : - FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.delta_depth) = - fun t -> let uu___ = delta_qualifier t in incr_delta_depth uu___ let (is_unknown : FStar_Syntax_Syntax.term -> Prims.bool) = fun t -> let uu___ = diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml index 13327a01148..33dae4e4ca6 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml @@ -1705,13 +1705,6 @@ let (handle_smt_goal : let fv = FStar_Syntax_Syntax.lid_as_fv lid FStar_Pervasives_Native.None in - let dd = - let uu___3 = - FStar_TypeChecker_Env.delta_depth_of_qninfo fv qn in - match uu___3 with - | FStar_Pervasives_Native.Some dd1 -> dd1 - | FStar_Pervasives_Native.None -> - FStar_Compiler_Effect.failwith "Expected a dd" in let uu___3 = FStar_Syntax_Syntax.lid_as_fv lid FStar_Pervasives_Native.None in @@ -2027,25 +2020,9 @@ let (splice : FStar_Syntax_Syntax.lbattrs = uu___11; FStar_Syntax_Syntax.lbpos = uu___12;_} -> - let uu___13 = - let uu___14 = - let uu___15 = - let uu___16 = - FStar_Syntax_Util.incr_delta_qualifier - lbdef in - FStar_Pervasives_Native.Some - uu___16 in - { - FStar_Syntax_Syntax.fv_name = - (fv.FStar_Syntax_Syntax.fv_name); - FStar_Syntax_Syntax.fv_delta = - uu___15; - FStar_Syntax_Syntax.fv_qual = - (fv.FStar_Syntax_Syntax.fv_qual) - } in - FStar_Pervasives.Inr uu___14 in { - FStar_Syntax_Syntax.lbname = uu___13; + FStar_Syntax_Syntax.lbname = + (FStar_Pervasives.Inr fv); FStar_Syntax_Syntax.lbunivs = (lb.FStar_Syntax_Syntax.lbunivs); FStar_Syntax_Syntax.lbtyp = diff --git a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml index 3abc54bb2a7..959617fa399 100644 --- a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml +++ b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml @@ -327,51 +327,31 @@ let (op_as_term : fun env -> fun arity -> fun op -> - let r l dd = + let r l = let uu___ = let uu___1 = let uu___2 = let uu___3 = FStar_Ident.range_of_id op in FStar_Ident.set_lid_range l uu___3 in - FStar_Syntax_Syntax.lid_and_dd_as_fv uu___2 dd + FStar_Syntax_Syntax.lid_and_dd_as_fv uu___2 FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___1 in FStar_Pervasives_Native.Some uu___ in let fallback uu___ = let uu___1 = FStar_Ident.string_of_id op in match uu___1 with - | "=" -> - r FStar_Parser_Const.op_Eq FStar_Syntax_Syntax.delta_equational - | "<" -> - r FStar_Parser_Const.op_LT FStar_Syntax_Syntax.delta_equational - | "<=" -> - r FStar_Parser_Const.op_LTE - FStar_Syntax_Syntax.delta_equational - | ">" -> - r FStar_Parser_Const.op_GT FStar_Syntax_Syntax.delta_equational - | ">=" -> - r FStar_Parser_Const.op_GTE - FStar_Syntax_Syntax.delta_equational - | "&&" -> - r FStar_Parser_Const.op_And - FStar_Syntax_Syntax.delta_equational - | "||" -> - r FStar_Parser_Const.op_Or FStar_Syntax_Syntax.delta_equational - | "+" -> - r FStar_Parser_Const.op_Addition - FStar_Syntax_Syntax.delta_equational - | "-" when arity = Prims.int_one -> - r FStar_Parser_Const.op_Minus - FStar_Syntax_Syntax.delta_equational - | "-" -> - r FStar_Parser_Const.op_Subtraction - FStar_Syntax_Syntax.delta_equational - | "/" -> - r FStar_Parser_Const.op_Division - FStar_Syntax_Syntax.delta_equational - | "%" -> - r FStar_Parser_Const.op_Modulus - FStar_Syntax_Syntax.delta_equational + | "=" -> r FStar_Parser_Const.op_Eq + | "<" -> r FStar_Parser_Const.op_LT + | "<=" -> r FStar_Parser_Const.op_LTE + | ">" -> r FStar_Parser_Const.op_GT + | ">=" -> r FStar_Parser_Const.op_GTE + | "&&" -> r FStar_Parser_Const.op_And + | "||" -> r FStar_Parser_Const.op_Or + | "+" -> r FStar_Parser_Const.op_Addition + | "-" when arity = Prims.int_one -> r FStar_Parser_Const.op_Minus + | "-" -> r FStar_Parser_Const.op_Subtraction + | "/" -> r FStar_Parser_Const.op_Division + | "%" -> r FStar_Parser_Const.op_Modulus | "@" -> ((let uu___3 = FStar_Ident.range_of_id op in let uu___4 = @@ -382,36 +362,15 @@ let (op_as_term : [uu___6] in (FStar_Errors_Codes.Warning_DeprecatedGeneric, uu___5) in FStar_Errors.log_issue_doc uu___3 uu___4); - r FStar_Parser_Const.list_tot_append_lid - (FStar_Syntax_Syntax.Delta_equational_at_level - (Prims.of_int (2)))) - | "<>" -> - r FStar_Parser_Const.op_notEq - FStar_Syntax_Syntax.delta_equational - | "~" -> - r FStar_Parser_Const.not_lid - (FStar_Syntax_Syntax.Delta_constant_at_level - (Prims.of_int (2))) - | "==" -> - r FStar_Parser_Const.eq2_lid - (FStar_Syntax_Syntax.Delta_constant_at_level - (Prims.of_int (2))) - | "<<" -> - r FStar_Parser_Const.precedes_lid - FStar_Syntax_Syntax.delta_constant - | "/\\" -> - r FStar_Parser_Const.and_lid - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) - | "\\/" -> - r FStar_Parser_Const.or_lid - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) - | "==>" -> - r FStar_Parser_Const.imp_lid - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) - | "<==>" -> - r FStar_Parser_Const.iff_lid - (FStar_Syntax_Syntax.Delta_constant_at_level - (Prims.of_int (2))) + r FStar_Parser_Const.list_tot_append_lid) + | "<>" -> r FStar_Parser_Const.op_notEq + | "~" -> r FStar_Parser_Const.not_lid + | "==" -> r FStar_Parser_Const.eq2_lid + | "<<" -> r FStar_Parser_Const.precedes_lid + | "/\\" -> r FStar_Parser_Const.and_lid + | "\\/" -> r FStar_Parser_Const.or_lid + | "==>" -> r FStar_Parser_Const.imp_lid + | "<==>" -> r FStar_Parser_Const.iff_lid | uu___2 -> FStar_Pervasives_Native.None in let uu___ = let uu___1 = @@ -2039,7 +1998,6 @@ let rec (desugar_data_pat : let uu___5 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.nil_lid - FStar_Syntax_Syntax.delta_constant (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor) in (uu___5, FStar_Pervasives_Native.None, []) in @@ -2057,7 +2015,6 @@ let rec (desugar_data_pat : let uu___4 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.cons_lid - FStar_Syntax_Syntax.delta_constant (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor) in (uu___4, FStar_Pervasives_Native.None, @@ -2149,7 +2106,6 @@ let rec (desugar_data_pat : FStar_Ident.lid_of_path ["__dummy__"] p1.FStar_Parser_AST.prange in FStar_Syntax_Syntax.lid_and_dd_as_fv lid - FStar_Syntax_Syntax.delta_constant (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Unresolved_constructor { @@ -2434,12 +2390,8 @@ and (desugar_machine_integer : FStar_Ident.path_of_text private_intro_nm in FStar_Ident.lid_of_path uu___3 range in let private_fv = - let uu___3 = - FStar_Syntax_Util.incr_delta_depth - (FStar_Pervasives_Native.__proj__Some__item__v - fv.FStar_Syntax_Syntax.fv_delta) in FStar_Syntax_Syntax.lid_and_dd_as_fv private_lid - uu___3 fv.FStar_Syntax_Syntax.fv_qual in + fv.FStar_Syntax_Syntax.fv_qual in { FStar_Syntax_Syntax.n = (FStar_Syntax_Syntax.Tm_fvar private_fv); @@ -2774,7 +2726,6 @@ and (desugar_term_maybe_top : FStar_Ident.set_lid_range FStar_Parser_Const.true_lid top.FStar_Parser_AST.range in FStar_Syntax_Syntax.fvar_with_dd uu___2 - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in (uu___1, noaqs) | FStar_Parser_AST.Name lid when @@ -2784,7 +2735,6 @@ and (desugar_term_maybe_top : FStar_Ident.set_lid_range FStar_Parser_Const.false_lid top.FStar_Parser_AST.range in FStar_Syntax_Syntax.fvar_with_dd uu___2 - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in (uu___1, noaqs) | FStar_Parser_AST.Projector (eff_name, id) when @@ -2800,8 +2750,7 @@ and (desugar_term_maybe_top : let lid = FStar_Syntax_Util.dm4f_lid ed txt in let uu___2 = FStar_Syntax_Syntax.fvar_with_dd lid - (FStar_Syntax_Syntax.Delta_constant_at_level - Prims.int_one) FStar_Pervasives_Native.None in + FStar_Pervasives_Native.None in (uu___2, noaqs) | FStar_Pervasives_Native.None -> let uu___2 = @@ -3303,7 +3252,6 @@ and (desugar_term_maybe_top : top.FStar_Parser_AST.range in FStar_Syntax_Syntax.lid_and_dd_as_fv uu___8 - FStar_Syntax_Syntax.delta_constant (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor) in let sc1 = @@ -3366,7 +3314,6 @@ and (desugar_term_maybe_top : top.FStar_Parser_AST.range in FStar_Syntax_Syntax.lid_and_dd_as_fv uu___9 - FStar_Syntax_Syntax.delta_constant (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor) in let sc1 = @@ -3730,8 +3677,7 @@ and (desugar_term_maybe_top : let uu___9 = let uu___10 = FStar_Ident.ident_of_lid l in FStar_Syntax_DsEnv.push_top_level_rec_binding - env1 uu___10 - FStar_Syntax_Syntax.delta_equational in + env1 uu___10 in (match uu___9 with | (env2, used_marker) -> (env2, (FStar_Pervasives.Inr l), @@ -3813,11 +3759,8 @@ and (desugar_term_maybe_top : FStar_Pervasives.Inl x | FStar_Pervasives.Inr l -> let uu___6 = - let uu___7 = - FStar_Syntax_Util.incr_delta_qualifier - body1 in FStar_Syntax_Syntax.lid_and_dd_as_fv l - uu___7 FStar_Pervasives_Native.None in + FStar_Pervasives_Native.None in FStar_Pervasives.Inr uu___6 in let body2 = if is_rec @@ -3957,11 +3900,8 @@ and (desugar_term_maybe_top : match uu___6 with | (body1, aq) -> let fv = - let uu___7 = - FStar_Syntax_Util.incr_delta_qualifier - t11 in FStar_Syntax_Syntax.lid_and_dd_as_fv l - uu___7 FStar_Pervasives_Native.None in + FStar_Pervasives_Native.None in let uu___7 = let uu___8 = let uu___9 = @@ -4094,9 +4034,7 @@ and (desugar_term_maybe_top : let uu___1 = let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv - FStar_Parser_Const.bool_lid - FStar_Syntax_Syntax.delta_constant - FStar_Pervasives_Native.None in + FStar_Parser_Const.bool_lid FStar_Pervasives_Native.None in FStar_Syntax_Syntax.Tm_fvar uu___2 in mk uu___1 in let uu___1 = desugar_term_aq env t1 in @@ -4326,7 +4264,6 @@ and (desugar_term_maybe_top : FStar_Ident.lid_of_path ["__dummy__"] top.FStar_Parser_AST.range in FStar_Syntax_Syntax.fvar_with_dd lid - FStar_Syntax_Syntax.delta_constant (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Unresolved_constructor uc)) in let mk_result args1 = @@ -4402,8 +4339,6 @@ and (desugar_term_maybe_top : match uu___2 with | FStar_Pervasives_Native.None -> FStar_Syntax_Syntax.fvar_with_dd f - (FStar_Syntax_Syntax.Delta_equational_at_level - Prims.int_one) (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Unresolved_projector FStar_Pervasives_Native.None)) @@ -4426,9 +4361,7 @@ and (desugar_term_maybe_top : let uu___3 = FStar_Ident.set_lid_range projname top.FStar_Parser_AST.range in - FStar_Syntax_Syntax.lid_and_dd_as_fv uu___3 - (FStar_Syntax_Syntax.Delta_equational_at_level - Prims.int_one) qual in + FStar_Syntax_Syntax.lid_and_dd_as_fv uu___3 qual in let qual1 = FStar_Syntax_Syntax.Unresolved_projector (FStar_Pervasives_Native.Some candidate_projector) in @@ -4436,8 +4369,6 @@ and (desugar_term_maybe_top : let uu___3 = qualify_field_names constrname [f] in FStar_Compiler_List.hd uu___3 in FStar_Syntax_Syntax.fvar_with_dd f1 - (FStar_Syntax_Syntax.Delta_equational_at_level - Prims.int_one) (FStar_Pervasives_Native.Some qual1) in let uu___2 = let uu___3 = @@ -4730,7 +4661,6 @@ and (desugar_term_maybe_top : let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.forall_intro_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___2 in let args = @@ -4774,7 +4704,6 @@ and (desugar_term_maybe_top : let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.exists_intro_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___2 in let args = @@ -4829,7 +4758,6 @@ and (desugar_term_maybe_top : let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.implies_intro_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___2 in let args = @@ -4861,7 +4789,6 @@ and (desugar_term_maybe_top : let head = let uu___1 = FStar_Syntax_Syntax.lid_and_dd_as_fv lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___1 in let args = @@ -4889,7 +4816,6 @@ and (desugar_term_maybe_top : let uu___1 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.and_intro_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___1 in let args = @@ -4924,7 +4850,6 @@ and (desugar_term_maybe_top : let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.forall_elim_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___2 in let args = @@ -5009,7 +4934,6 @@ and (desugar_term_maybe_top : let uu___3 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.exists_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___3 in let args = @@ -5037,7 +4961,6 @@ and (desugar_term_maybe_top : let uu___3 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.exists_elim_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___3 in let args = @@ -5136,7 +5059,6 @@ and (desugar_term_maybe_top : let uu___1 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.implies_elim_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___1 in let args = @@ -5186,7 +5108,6 @@ and (desugar_term_maybe_top : let uu___3 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.or_elim_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___3 in let extra_binder = @@ -5253,7 +5174,6 @@ and (desugar_term_maybe_top : let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.and_elim_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___2 in let args = @@ -5920,7 +5840,6 @@ and (desugar_comp : pat.FStar_Syntax_Syntax.pos in FStar_Syntax_Syntax.fvar_with_dd uu___10 - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in let uu___10 = let uu___11 = @@ -6130,7 +6049,6 @@ and (desugar_formula : let uu___1 = FStar_Ident.set_lid_range q b.FStar_Parser_AST.brange in FStar_Syntax_Syntax.fvar_with_dd uu___1 - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) FStar_Pervasives_Native.None in desugar_quant q_head b pats true body | FStar_Parser_AST.QExists (b::[], pats, body) -> @@ -6139,7 +6057,6 @@ and (desugar_formula : let uu___1 = FStar_Ident.set_lid_range q b.FStar_Parser_AST.brange in FStar_Syntax_Syntax.fvar_with_dd uu___1 - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) FStar_Pervasives_Native.None in desugar_quant q_head b pats true body | FStar_Parser_AST.QuantOp (i, b::[], pats, body) -> @@ -6508,14 +6425,11 @@ let (mk_indexed_projector_names : if only_decl then [decl] else - (let dd = - FStar_Syntax_Syntax.Delta_equational_at_level - Prims.int_one in - let lb = + (let lb = let uu___2 = let uu___3 = FStar_Syntax_Syntax.lid_and_dd_as_fv - field_name dd FStar_Pervasives_Native.None in + field_name FStar_Pervasives_Native.None in FStar_Pervasives.Inr uu___3 in { FStar_Syntax_Syntax.lbname = uu___2; @@ -6645,11 +6559,10 @@ let (mk_typ_abbrev : FStar_Syntax_DsEnv.lookup_letbinding_quals_and_attrs env lid in FStar_Pervasives_Native.snd uu___ in - let dd = FStar_Syntax_Util.incr_delta_qualifier t in let lb = let uu___ = let uu___1 = - FStar_Syntax_Syntax.lid_and_dd_as_fv lid dd + FStar_Syntax_Syntax.lid_and_dd_as_fv lid FStar_Pervasives_Native.None in FStar_Pervasives.Inr uu___1 in let uu___1 = @@ -7008,12 +6921,12 @@ let rec (desugar_tycon : } in let uu___2 = FStar_Syntax_DsEnv.push_top_level_rec_binding _env - id FStar_Syntax_Syntax.delta_constant in + id in (match uu___2 with | (_env1, uu___3) -> let uu___4 = FStar_Syntax_DsEnv.push_top_level_rec_binding - _env' id FStar_Syntax_Syntax.delta_constant in + _env' id in (match uu___4 with | (_env2, uu___5) -> (_env1, _env2, se, tconstr)))) | uu___1 -> FStar_Compiler_Effect.failwith "Unexpected tycon" in @@ -9303,7 +9216,6 @@ and (desugar_decl_core : let uu___5 = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.tcclass_lid - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in uu___5 :: (se.FStar_Syntax_Syntax.sigattrs) in FStar_Syntax_Util.deduplicate_terms uu___4 in @@ -9332,7 +9244,6 @@ and (desugar_decl_core : let uu___6 = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.tcclass_lid - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in uu___6 :: (se.FStar_Syntax_Syntax.sigattrs) in FStar_Syntax_Util.deduplicate_terms uu___5 in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Common.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Common.ml index 456504c264b..5e803c000c9 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Common.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Common.ml @@ -42,63 +42,69 @@ type 'a problem = logical_guard_uvar: FStar_Syntax_Syntax.ctx_uvar ; reason: Prims.string Prims.list ; loc: FStar_Compiler_Range_Type.range ; - rank: rank_t FStar_Pervasives_Native.option } + rank: rank_t FStar_Pervasives_Native.option ; + logical: Prims.bool } let __proj__Mkproblem__item__pid : 'a . 'a problem -> Prims.int = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> pid + reason; loc; rank; logical;_} -> pid let __proj__Mkproblem__item__lhs : 'a . 'a problem -> 'a = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> lhs + reason; loc; rank; logical;_} -> lhs let __proj__Mkproblem__item__relation : 'a . 'a problem -> rel = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> relation + reason; loc; rank; logical;_} -> relation let __proj__Mkproblem__item__rhs : 'a . 'a problem -> 'a = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> rhs + reason; loc; rank; logical;_} -> rhs let __proj__Mkproblem__item__element : 'a . 'a problem -> FStar_Syntax_Syntax.bv FStar_Pervasives_Native.option = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> element + reason; loc; rank; logical;_} -> element let __proj__Mkproblem__item__logical_guard : 'a . 'a problem -> FStar_Syntax_Syntax.term = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> logical_guard + reason; loc; rank; logical;_} -> logical_guard let __proj__Mkproblem__item__logical_guard_uvar : 'a . 'a problem -> FStar_Syntax_Syntax.ctx_uvar = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> logical_guard_uvar + reason; loc; rank; logical;_} -> logical_guard_uvar let __proj__Mkproblem__item__reason : 'a . 'a problem -> Prims.string Prims.list = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> reason + reason; loc; rank; logical;_} -> reason let __proj__Mkproblem__item__loc : 'a . 'a problem -> FStar_Compiler_Range_Type.range = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> loc + reason; loc; rank; logical;_} -> loc let __proj__Mkproblem__item__rank : 'a . 'a problem -> rank_t FStar_Pervasives_Native.option = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> rank + reason; loc; rank; logical;_} -> rank +let __proj__Mkproblem__item__logical : 'a . 'a problem -> Prims.bool = + fun projectee -> + match projectee with + | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; + reason; loc; rank; logical;_} -> logical type prob = | TProb of FStar_Syntax_Syntax.typ problem | CProb of FStar_Syntax_Syntax.comp problem diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml index a33bc00b5aa..ec893d12455 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml @@ -1666,39 +1666,14 @@ let (maybe_relate_after_unfolding : fun g -> fun t0 -> fun t1 -> - let rec delta_depth_of_head t = - let head = FStar_Syntax_Util.leftmost_head t in - let uu___ = - let uu___1 = FStar_Syntax_Util.un_uinst head in - uu___1.FStar_Syntax_Syntax.n in - match uu___ with - | FStar_Syntax_Syntax.Tm_fvar fv -> - let uu___1 = FStar_TypeChecker_Env.delta_depth_of_fv g fv in - FStar_Pervasives_Native.Some uu___1 - | FStar_Syntax_Syntax.Tm_match - { FStar_Syntax_Syntax.scrutinee = t2; - FStar_Syntax_Syntax.ret_opt = uu___1; - FStar_Syntax_Syntax.brs = uu___2; - FStar_Syntax_Syntax.rc_opt1 = uu___3;_} - -> delta_depth_of_head t2 - | uu___1 -> FStar_Pervasives_Native.None in - let dd0 = delta_depth_of_head t0 in - let dd1 = delta_depth_of_head t1 in - match (dd0, dd1) with - | (FStar_Pervasives_Native.Some uu___, FStar_Pervasives_Native.None) - -> Left - | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.Some uu___) - -> Right - | (FStar_Pervasives_Native.Some dd01, FStar_Pervasives_Native.Some - dd11) -> - if dd01 = dd11 - then Both - else - (let uu___1 = - FStar_TypeChecker_Common.delta_depth_greater_than dd01 dd11 in - if uu___1 then Left else Right) - | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> - Neither + let dd0 = FStar_TypeChecker_Env.delta_depth_of_term g t0 in + let dd1 = FStar_TypeChecker_Env.delta_depth_of_term g t1 in + if dd0 = dd1 + then Both + else + (let uu___1 = + FStar_TypeChecker_Common.delta_depth_greater_than dd0 dd1 in + if uu___1 then Left else Right) let rec (check_relation : env -> relation -> diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml index 26392457f1f..926fa890760 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml @@ -37,8 +37,7 @@ let (mk_toplevel_definition : "Registering top-level definition: %s\n%s\n" uu___3 uu___4)) else ()); (let fv = - let uu___1 = FStar_Syntax_Util.incr_delta_qualifier def in - FStar_Syntax_Syntax.lid_and_dd_as_fv lident uu___1 + FStar_Syntax_Syntax.lid_and_dd_as_fv lident FStar_Pervasives_Native.None in let lbname = FStar_Pervasives.Inr fv in let lb = @@ -667,8 +666,7 @@ let (gen_wps_for_free : let l_ite = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.ite_lid - (FStar_Syntax_Syntax.Delta_constant_at_level - (Prims.of_int (2))) FStar_Pervasives_Native.None in + FStar_Pervasives_Native.None in let uu___5 = let uu___6 = let uu___7 = @@ -825,6 +823,7 @@ let (gen_wps_for_free : FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; + FStar_TypeChecker_Env.UnfoldTac; FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant] env2 t in let uu___3 = @@ -1021,6 +1020,7 @@ let (gen_wps_for_free : FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; + FStar_TypeChecker_Env.UnfoldTac; FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant] env2 t in let uu___3 = @@ -1045,8 +1045,6 @@ let (gen_wps_for_free : FStar_TypeChecker_Env.lookup_projector env2 uu___5 i in FStar_Syntax_Syntax.fvar_with_dd uu___4 - (FStar_Syntax_Syntax.Delta_constant_at_level - Prims.int_one) FStar_Pervasives_Native.None in FStar_Syntax_Util.mk_app projector [(tuple, FStar_Pervasives_Native.None)] in @@ -1207,7 +1205,6 @@ let (gen_wps_for_free : let uu___5 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.guard_free - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___5 in let pat = @@ -1773,6 +1770,7 @@ and (star_type' : FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Env.EraseUniverses; FStar_TypeChecker_Env.Inlining; + FStar_TypeChecker_Env.UnfoldTac; FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant] env1.tcenv t1 in @@ -2296,6 +2294,7 @@ and (infer : FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; + FStar_TypeChecker_Env.UnfoldTac; FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; FStar_TypeChecker_Env.EraseUniverses] env1.tcenv in @@ -2500,6 +2499,7 @@ and (infer : FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; + FStar_TypeChecker_Env.UnfoldTac; FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; FStar_TypeChecker_Env.EraseUniverses] @@ -2604,16 +2604,15 @@ and (infer : FStar_Syntax_Syntax.fv_name = { FStar_Syntax_Syntax.v = lid; FStar_Syntax_Syntax.p = uu___1;_}; - FStar_Syntax_Syntax.fv_delta = uu___2; - FStar_Syntax_Syntax.fv_qual = uu___3;_} + FStar_Syntax_Syntax.fv_qual = uu___2;_} -> - let uu___4 = - let uu___5 = FStar_TypeChecker_Env.lookup_lid env1.tcenv lid in - FStar_Pervasives_Native.fst uu___5 in - (match uu___4 with - | (uu___5, t) -> - let uu___6 = let uu___7 = normalize t in N uu___7 in - (uu___6, e, e)) + let uu___3 = + let uu___4 = FStar_TypeChecker_Env.lookup_lid env1.tcenv lid in + FStar_Pervasives_Native.fst uu___4 in + (match uu___3 with + | (uu___4, t) -> + let uu___5 = let uu___6 = normalize t in N uu___6 in + (uu___5, e, e)) | FStar_Syntax_Syntax.Tm_app { FStar_Syntax_Syntax.hd = @@ -3856,7 +3855,8 @@ let (n : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term) = FStar_TypeChecker_Normalize.normalize - [FStar_TypeChecker_Env.Beta; + [FStar_TypeChecker_Env.UnfoldTac; + FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; FStar_TypeChecker_Env.DoNotUnfoldPureLets; FStar_TypeChecker_Env.Eager_unfolding; @@ -4469,7 +4469,6 @@ let (cps_and_elaborate : (let uu___16 = FStar_Syntax_Syntax.lid_and_dd_as_fv l' - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___16)) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml index 7b0d9d3fa16..bd7a122b030 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml @@ -249,13 +249,6 @@ let solve_goals_with_tac : let fv = FStar_Syntax_Syntax.lid_as_fv lid FStar_Pervasives_Native.None in - let dd = - let uu___3 = - FStar_TypeChecker_Env.delta_depth_of_qninfo fv qn in - match uu___3 with - | FStar_Pervasives_Native.Some dd1 -> dd1 - | FStar_Pervasives_Native.None -> - FStar_Compiler_Effect.failwith "Expected a dd" in let term = let uu___3 = FStar_Syntax_Syntax.lid_as_fv lid diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml index 0f575764d77..c0f4329182e 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml @@ -3669,165 +3669,187 @@ let (lookup_nonrec_definition : fun lid -> let uu___ = lookup_qname env1 lid in lookup_definition_qninfo_aux false delta_levels lid uu___ -let (delta_depth_of_qninfo_lid : - FStar_Ident.lident -> - qninfo -> FStar_Syntax_Syntax.delta_depth FStar_Pervasives_Native.option) - = - fun lid -> - fun qn -> - match qn with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_zero) - | FStar_Pervasives_Native.Some (FStar_Pervasives.Inl uu___, uu___1) -> - FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_zero) - | FStar_Pervasives_Native.Some - (FStar_Pervasives.Inr (se, uu___), uu___1) -> - (match se.FStar_Syntax_Syntax.sigel with - | FStar_Syntax_Syntax.Sig_inductive_typ uu___2 -> - FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_zero) - | FStar_Syntax_Syntax.Sig_bundle uu___2 -> - FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_zero) - | FStar_Syntax_Syntax.Sig_datacon uu___2 -> - FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_zero) - | FStar_Syntax_Syntax.Sig_declare_typ uu___2 -> - let uu___3 = - FStar_Syntax_DsEnv.delta_depth_of_declaration lid - se.FStar_Syntax_Syntax.sigquals in - FStar_Pervasives_Native.Some uu___3 - | FStar_Syntax_Syntax.Sig_let - { FStar_Syntax_Syntax.lbs1 = (uu___2, lbs); - FStar_Syntax_Syntax.lids1 = uu___3;_} - -> - FStar_Compiler_Util.find_map lbs - (fun lb -> - let fv = - FStar_Compiler_Util.right lb.FStar_Syntax_Syntax.lbname in - let uu___4 = FStar_Syntax_Syntax.fv_eq_lid fv lid in - if uu___4 - then fv.FStar_Syntax_Syntax.fv_delta - else FStar_Pervasives_Native.None) - | FStar_Syntax_Syntax.Sig_fail uu___2 -> - FStar_Compiler_Effect.failwith - "impossible: delta_depth_of_qninfo" - | FStar_Syntax_Syntax.Sig_splice uu___2 -> - FStar_Compiler_Effect.failwith - "impossible: delta_depth_of_qninfo" - | FStar_Syntax_Syntax.Sig_assume uu___2 -> - FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Sig_new_effect uu___2 -> - FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Sig_sub_effect uu___2 -> - FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Sig_effect_abbrev uu___2 -> - FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Sig_pragma uu___2 -> - FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Sig_polymonadic_bind uu___2 -> - FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Sig_polymonadic_subcomp uu___2 -> - FStar_Pervasives_Native.None) -let (prims_dd_lids : FStar_Ident.lident Prims.list) = - [FStar_Parser_Const.and_lid; - FStar_Parser_Const.or_lid; - FStar_Parser_Const.imp_lid; - FStar_Parser_Const.iff_lid; - FStar_Parser_Const.true_lid; - FStar_Parser_Const.false_lid; - FStar_Parser_Const.not_lid; - FStar_Parser_Const.b2t_lid; - FStar_Parser_Const.eq2_lid; - FStar_Parser_Const.eq3_lid; - FStar_Parser_Const.op_Eq; - FStar_Parser_Const.op_LT; - FStar_Parser_Const.op_LTE; - FStar_Parser_Const.op_GT; - FStar_Parser_Const.op_GTE; - FStar_Parser_Const.forall_lid; - FStar_Parser_Const.exists_lid; - FStar_Parser_Const.haseq_lid; - FStar_Parser_Const.op_And; - FStar_Parser_Const.op_Or; - FStar_Parser_Const.op_Negation] -let (is_prims_dd_lid : FStar_Ident.lident -> Prims.bool) = - fun l -> - FStar_Compiler_List.existsb (fun l0 -> FStar_Ident.lid_equals l l0) - prims_dd_lids -let (delta_depth_of_qninfo : - FStar_Syntax_Syntax.fv -> - qninfo -> FStar_Syntax_Syntax.delta_depth FStar_Pervasives_Native.option) +let rec (delta_depth_of_qninfo_lid : + env -> FStar_Ident.lident -> qninfo -> FStar_Syntax_Syntax.delta_depth) = + fun env1 -> + fun lid -> + fun qn -> + match qn with + | FStar_Pervasives_Native.None -> FStar_Syntax_Syntax.delta_constant + | FStar_Pervasives_Native.Some (FStar_Pervasives.Inl uu___, uu___1) + -> FStar_Syntax_Syntax.delta_constant + | FStar_Pervasives_Native.Some + (FStar_Pervasives.Inr (se, uu___), uu___1) -> + (match se.FStar_Syntax_Syntax.sigel with + | FStar_Syntax_Syntax.Sig_inductive_typ uu___2 -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Sig_bundle uu___2 -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Sig_datacon uu___2 -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Sig_declare_typ uu___2 -> + let d0 = + let uu___3 = FStar_Syntax_Util.is_primop_lid lid in + if uu___3 + then FStar_Syntax_Syntax.delta_equational + else FStar_Syntax_Syntax.delta_constant in + let uu___3 = + (FStar_Compiler_Util.for_some + FStar_Syntax_Syntax.uu___is_Assumption + se.FStar_Syntax_Syntax.sigquals) + && + (let uu___4 = + FStar_Compiler_Util.for_some + FStar_Syntax_Syntax.uu___is_New + se.FStar_Syntax_Syntax.sigquals in + Prims.op_Negation uu___4) in + if uu___3 then FStar_Syntax_Syntax.Delta_abstract d0 else d0 + | FStar_Syntax_Syntax.Sig_let + { FStar_Syntax_Syntax.lbs1 = (uu___2, lbs); + FStar_Syntax_Syntax.lids1 = uu___3;_} + -> + let uu___4 = + FStar_Compiler_Util.find_map lbs + (fun lb -> + let fv = + FStar_Compiler_Util.right + lb.FStar_Syntax_Syntax.lbname in + let uu___5 = FStar_Syntax_Syntax.fv_eq_lid fv lid in + if uu___5 + then + let uu___6 = + let uu___7 = + delta_depth_of_term env1 + lb.FStar_Syntax_Syntax.lbdef in + FStar_Syntax_Util.incr_delta_depth uu___7 in + FStar_Pervasives_Native.Some uu___6 + else FStar_Pervasives_Native.None) in + FStar_Compiler_Util.must uu___4 + | FStar_Syntax_Syntax.Sig_fail uu___2 -> + FStar_Compiler_Effect.failwith + "impossible: delta_depth_of_qninfo" + | FStar_Syntax_Syntax.Sig_splice uu___2 -> + FStar_Compiler_Effect.failwith + "impossible: delta_depth_of_qninfo" + | FStar_Syntax_Syntax.Sig_assume uu___2 -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Sig_new_effect uu___2 -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Sig_sub_effect uu___2 -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Sig_effect_abbrev uu___2 -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Sig_pragma uu___2 -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Sig_polymonadic_bind uu___2 -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Sig_polymonadic_subcomp uu___2 -> + FStar_Syntax_Syntax.delta_constant) +and (delta_depth_of_qninfo : + env -> FStar_Syntax_Syntax.fv -> qninfo -> FStar_Syntax_Syntax.delta_depth) = - fun fv -> - fun qn -> - let lid = (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - let uu___ = - (is_prims_dd_lid lid) && - (FStar_Pervasives_Native.uu___is_Some - fv.FStar_Syntax_Syntax.fv_delta) in - if uu___ - then fv.FStar_Syntax_Syntax.fv_delta - else delta_depth_of_qninfo_lid lid qn -let (delta_depth_of_fv : + fun env1 -> + fun fv -> + fun qn -> + delta_depth_of_qninfo_lid env1 + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v qn +and (delta_depth_of_fv : env -> FStar_Syntax_Syntax.fv -> FStar_Syntax_Syntax.delta_depth) = fun env1 -> fun fv -> let lid = (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in let uu___ = - (is_prims_dd_lid lid) && - (FStar_Pervasives_Native.uu___is_Some - fv.FStar_Syntax_Syntax.fv_delta) in - if uu___ - then FStar_Compiler_Util.must fv.FStar_Syntax_Syntax.fv_delta - else - (let uu___2 = - let uu___3 = FStar_Ident.string_of_lid lid in - FStar_Compiler_Util.smap_try_find env1.fv_delta_depths uu___3 in - if FStar_Compiler_Util.is_some uu___2 - then FStar_Compiler_Util.must uu___2 - else - (let uu___4 = - let uu___5 = + let uu___1 = FStar_Ident.string_of_lid lid in + FStar_Compiler_Util.smap_try_find env1.fv_delta_depths uu___1 in + match uu___ with + | FStar_Pervasives_Native.Some dd -> dd + | FStar_Pervasives_Native.None -> + ((let uu___2 = FStar_Ident.string_of_lid lid in + FStar_Compiler_Util.smap_add env1.fv_delta_depths uu___2 + FStar_Syntax_Syntax.delta_equational); + (let d = + let uu___2 = lookup_qname env1 (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - delta_depth_of_qninfo fv uu___5 in - match uu___4 with - | FStar_Pervasives_Native.None -> - let uu___5 = - let uu___6 = FStar_Syntax_Print.fv_to_string fv in - FStar_Compiler_Util.format1 "Delta depth not found for %s" - uu___6 in - FStar_Compiler_Effect.failwith uu___5 - | FStar_Pervasives_Native.Some d -> - ((let uu___6 = - ((FStar_Pervasives_Native.uu___is_Some - fv.FStar_Syntax_Syntax.fv_delta) - && - (d <> - (FStar_Pervasives_Native.__proj__Some__item__v - fv.FStar_Syntax_Syntax.fv_delta))) - && (FStar_Options.debug_any ()) in - if uu___6 - then - let uu___7 = FStar_Syntax_Print.fv_to_string fv in - let uu___8 = - FStar_Class_Show.show - FStar_Syntax_Syntax.showable_delta_depth - (FStar_Pervasives_Native.__proj__Some__item__v - fv.FStar_Syntax_Syntax.fv_delta) in - let uu___9 = - FStar_Class_Show.show - FStar_Syntax_Syntax.showable_delta_depth d in - FStar_Compiler_Util.print3 - "WARNING WARNING WARNING fv=%s, delta_depth=%s, env.delta_depth=%s\n" - uu___7 uu___8 uu___9 - else ()); - (let uu___7 = FStar_Ident.string_of_lid lid in - FStar_Compiler_Util.smap_add env1.fv_delta_depths uu___7 d); - d))) + delta_depth_of_qninfo env1 fv uu___2 in + (let uu___3 = FStar_Ident.string_of_lid lid in + FStar_Compiler_Util.smap_add env1.fv_delta_depths uu___3 d); + d)) +and (fv_delta_depth : + env -> FStar_Syntax_Syntax.fv -> FStar_Syntax_Syntax.delta_depth) = + fun env1 -> + fun fv -> + let d = delta_depth_of_fv env1 fv in + match d with + | FStar_Syntax_Syntax.Delta_abstract + (FStar_Syntax_Syntax.Delta_constant_at_level l) -> + let uu___ = + (let uu___1 = FStar_Ident.string_of_lid env1.curmodule in + let uu___2 = + FStar_Ident.nsstr + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + uu___1 = uu___2) && (Prims.op_Negation env1.is_iface) in + if uu___ + then FStar_Syntax_Syntax.Delta_constant_at_level l + else FStar_Syntax_Syntax.delta_constant + | d1 -> d1 +and (delta_depth_of_term : + env -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.delta_depth) = + fun env1 -> + fun t -> + let t1 = FStar_Syntax_Util.unmeta t in + match t1.FStar_Syntax_Syntax.n with + | FStar_Syntax_Syntax.Tm_meta uu___ -> + FStar_Compiler_Effect.failwith "Impossible (delta depth of term)" + | FStar_Syntax_Syntax.Tm_delayed uu___ -> + FStar_Compiler_Effect.failwith "Impossible (delta depth of term)" + | FStar_Syntax_Syntax.Tm_lazy i -> + let uu___ = FStar_Syntax_Util.unfold_lazy i in + delta_depth_of_term env1 uu___ + | FStar_Syntax_Syntax.Tm_fvar fv -> fv_delta_depth env1 fv + | FStar_Syntax_Syntax.Tm_bvar uu___ -> + FStar_Syntax_Syntax.delta_equational + | FStar_Syntax_Syntax.Tm_name uu___ -> + FStar_Syntax_Syntax.delta_equational + | FStar_Syntax_Syntax.Tm_match uu___ -> + FStar_Syntax_Syntax.delta_equational + | FStar_Syntax_Syntax.Tm_uvar uu___ -> + FStar_Syntax_Syntax.delta_equational + | FStar_Syntax_Syntax.Tm_unknown -> + FStar_Syntax_Syntax.delta_equational + | FStar_Syntax_Syntax.Tm_type uu___ -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Tm_quoted uu___ -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Tm_constant uu___ -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Tm_arrow uu___ -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Tm_uinst (t2, uu___) -> + delta_depth_of_term env1 t2 + | FStar_Syntax_Syntax.Tm_refine + { + FStar_Syntax_Syntax.b = + { FStar_Syntax_Syntax.ppname = uu___; + FStar_Syntax_Syntax.index = uu___1; + FStar_Syntax_Syntax.sort = t2;_}; + FStar_Syntax_Syntax.phi = uu___2;_} + -> delta_depth_of_term env1 t2 + | FStar_Syntax_Syntax.Tm_ascribed + { FStar_Syntax_Syntax.tm = t2; FStar_Syntax_Syntax.asc = uu___; + FStar_Syntax_Syntax.eff_opt = uu___1;_} + -> delta_depth_of_term env1 t2 + | FStar_Syntax_Syntax.Tm_app + { FStar_Syntax_Syntax.hd = t2; FStar_Syntax_Syntax.args = uu___;_} + -> delta_depth_of_term env1 t2 + | FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = uu___; FStar_Syntax_Syntax.body = t2; + FStar_Syntax_Syntax.rc_opt = uu___1;_} + -> delta_depth_of_term env1 t2 + | FStar_Syntax_Syntax.Tm_let + { FStar_Syntax_Syntax.lbs = uu___; + FStar_Syntax_Syntax.body1 = t2;_} + -> delta_depth_of_term env1 t2 let (quals_of_qninfo : qninfo -> FStar_Syntax_Syntax.qualifier Prims.list FStar_Pervasives_Native.option) @@ -7041,12 +7063,6 @@ let (fvar_of_nonqual_lid : fun env1 -> fun lid -> let qn = lookup_qname env1 lid in - let dd = - let uu___ = delta_depth_of_qninfo_lid lid qn in - match uu___ with - | FStar_Pervasives_Native.None -> - FStar_Compiler_Effect.failwith "Unexpected no delta_depth" - | FStar_Pervasives_Native.Some dd1 -> dd1 in FStar_Syntax_Syntax.fvar lid FStar_Pervasives_Native.None let (split_smt_query : env -> diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml index 2524b72fdc7..45c3aa2d80c 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml @@ -2803,27 +2803,25 @@ let rec (norm : rebuild cfg empty_env stack2 t1 | FStar_Syntax_Syntax.Tm_fvar { FStar_Syntax_Syntax.fv_name = uu___2; - FStar_Syntax_Syntax.fv_delta = uu___3; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Data_ctor);_} -> (FStar_TypeChecker_Cfg.log_unfolding cfg - (fun uu___5 -> - let uu___6 = FStar_Syntax_Print.term_to_string t1 in + (fun uu___4 -> + let uu___5 = FStar_Syntax_Print.term_to_string t1 in FStar_Compiler_Util.print1 - " >> This is a constructor: %s\n" uu___6); + " >> This is a constructor: %s\n" uu___5); rebuild cfg empty_env stack2 t1) | FStar_Syntax_Syntax.Tm_fvar { FStar_Syntax_Syntax.fv_name = uu___2; - FStar_Syntax_Syntax.fv_delta = uu___3; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Record_ctor uu___4);_} + (FStar_Syntax_Syntax.Record_ctor uu___3);_} -> (FStar_TypeChecker_Cfg.log_unfolding cfg - (fun uu___6 -> - let uu___7 = FStar_Syntax_Print.term_to_string t1 in + (fun uu___5 -> + let uu___6 = FStar_Syntax_Print.term_to_string t1 in FStar_Compiler_Util.print1 - " >> This is a constructor: %s\n" uu___7); + " >> This is a constructor: %s\n" uu___6); rebuild cfg empty_env stack2 t1) | FStar_Syntax_Syntax.Tm_fvar fv -> let lid = FStar_Syntax_Syntax.lid_of_fv fv in @@ -2831,10 +2829,10 @@ let rec (norm : FStar_TypeChecker_Env.lookup_qname cfg.FStar_TypeChecker_Cfg.tcenv lid in let uu___2 = - FStar_TypeChecker_Env.delta_depth_of_qninfo fv qninfo in + FStar_TypeChecker_Env.delta_depth_of_qninfo + cfg.FStar_TypeChecker_Cfg.tcenv fv qninfo in (match uu___2 with - | FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_constant_at_level uu___3) when + | FStar_Syntax_Syntax.Delta_constant_at_level uu___3 when uu___3 = Prims.int_zero -> (FStar_TypeChecker_Cfg.log_unfolding cfg (fun uu___5 -> @@ -7811,17 +7809,15 @@ and (do_rebuild : | FStar_Syntax_Syntax.Tm_constant uu___2 -> true | FStar_Syntax_Syntax.Tm_fvar { FStar_Syntax_Syntax.fv_name = uu___2; - FStar_Syntax_Syntax.fv_delta = uu___3; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Data_ctor);_} -> true | FStar_Syntax_Syntax.Tm_fvar { FStar_Syntax_Syntax.fv_name = uu___2; - FStar_Syntax_Syntax.fv_delta = uu___3; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Record_ctor uu___4);_} + (FStar_Syntax_Syntax.Record_ctor uu___3);_} -> true | uu___2 -> false in let guard_when_clause wopt b rest = @@ -9633,7 +9629,7 @@ let (get_n_binders : FStar_Syntax_Syntax.term -> (FStar_Syntax_Syntax.binder Prims.list * FStar_Syntax_Syntax.comp)) = fun env1 -> fun n -> fun t -> get_n_binders' env1 [] n t -let (uu___3792 : unit) = +let (uu___3791 : unit) = FStar_Compiler_Effect.op_Colon_Equals __get_n_binders get_n_binders' let (maybe_unfold_head_fv : FStar_TypeChecker_Env.env -> diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_PatternUtils.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_PatternUtils.ml index 59d2cb75bff..48f71b4ccac 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_PatternUtils.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_PatternUtils.ml @@ -17,10 +17,9 @@ let rec (elaborate_pat : match p.FStar_Syntax_Syntax.v with | FStar_Syntax_Syntax.Pat_cons ({ FStar_Syntax_Syntax.fv_name = uu___; - FStar_Syntax_Syntax.fv_delta = uu___1; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Unresolved_constructor uu___2);_}, - uu___3, uu___4) + (FStar_Syntax_Syntax.Unresolved_constructor uu___1);_}, + uu___2, uu___3) -> p | FStar_Syntax_Syntax.Pat_cons (fv, us_opt, pats) -> let pats1 = diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml index 8270d792235..b0078c87d6e 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml @@ -124,7 +124,7 @@ let (uu___is_DeferAny : defer_ok_t -> Prims.bool) = let (uu___is_DeferFlexFlexOnly : defer_ok_t -> Prims.bool) = fun projectee -> match projectee with | DeferFlexFlexOnly -> true | uu___ -> false -let (uu___76 : defer_ok_t FStar_Class_Show.showable) = +let (uu___78 : defer_ok_t FStar_Class_Show.showable) = { FStar_Class_Show.show = (fun uu___ -> @@ -545,7 +545,8 @@ let invert : (p.FStar_TypeChecker_Common.logical_guard_uvar); FStar_TypeChecker_Common.reason = (p.FStar_TypeChecker_Common.reason); FStar_TypeChecker_Common.loc = (p.FStar_TypeChecker_Common.loc); - FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank) + FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = (p.FStar_TypeChecker_Common.logical) } let maybe_invert : 'uuuuu . @@ -584,7 +585,9 @@ let (make_prob_eq : FStar_TypeChecker_Common.reason = (p.FStar_TypeChecker_Common.reason); FStar_TypeChecker_Common.loc = (p.FStar_TypeChecker_Common.loc); - FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank) + FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (p.FStar_TypeChecker_Common.logical) } | FStar_TypeChecker_Common.CProb p -> FStar_TypeChecker_Common.CProb @@ -602,7 +605,9 @@ let (make_prob_eq : FStar_TypeChecker_Common.reason = (p.FStar_TypeChecker_Common.reason); FStar_TypeChecker_Common.loc = (p.FStar_TypeChecker_Common.loc); - FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank) + FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (p.FStar_TypeChecker_Common.logical) } let (vary_rel : FStar_TypeChecker_Common.rel -> variance -> FStar_TypeChecker_Common.rel) = @@ -1019,11 +1024,23 @@ let (prob_to_string : let uu___4 = let uu___5 = let uu___6 = term_to_string p.FStar_TypeChecker_Common.rhs in - [uu___6] in + let uu___7 = + let uu___8 = + let uu___9 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + p.FStar_TypeChecker_Common.logical in + [uu___9] in + (match p.FStar_TypeChecker_Common.reason with + | [] -> "" + | r::uu___9 -> r) :: uu___8 in + uu___6 :: uu___7 in (rel_to_string p.FStar_TypeChecker_Common.relation) :: uu___5 in uu___3 :: uu___4 in uu___1 :: uu___2 in - FStar_Compiler_Util.format "\n%s:\t%s \n\t\t%s\n\t%s\n" uu___ + FStar_Compiler_Util.format + "\n%s:\t%s \n\t\t%s\n\t%s\n\t(reason:%s) (logical:%s)\n" uu___ | FStar_TypeChecker_Common.CProb p -> let uu___ = FStar_Compiler_Util.string_of_int p.FStar_TypeChecker_Common.pid in @@ -1236,6 +1253,60 @@ let (p_invert : FStar_TypeChecker_Common.TProb (invert p) | FStar_TypeChecker_Common.CProb p -> FStar_TypeChecker_Common.CProb (invert p) +let (p_logical : FStar_TypeChecker_Common.prob -> Prims.bool) = + fun uu___ -> + match uu___ with + | FStar_TypeChecker_Common.TProb p -> p.FStar_TypeChecker_Common.logical + | FStar_TypeChecker_Common.CProb p -> p.FStar_TypeChecker_Common.logical +let (set_logical : + Prims.bool -> + FStar_TypeChecker_Common.prob -> FStar_TypeChecker_Common.prob) + = + fun b -> + fun uu___ -> + match uu___ with + | FStar_TypeChecker_Common.TProb p -> + FStar_TypeChecker_Common.TProb + { + FStar_TypeChecker_Common.pid = (p.FStar_TypeChecker_Common.pid); + FStar_TypeChecker_Common.lhs = (p.FStar_TypeChecker_Common.lhs); + FStar_TypeChecker_Common.relation = + (p.FStar_TypeChecker_Common.relation); + FStar_TypeChecker_Common.rhs = (p.FStar_TypeChecker_Common.rhs); + FStar_TypeChecker_Common.element = + (p.FStar_TypeChecker_Common.element); + FStar_TypeChecker_Common.logical_guard = + (p.FStar_TypeChecker_Common.logical_guard); + FStar_TypeChecker_Common.logical_guard_uvar = + (p.FStar_TypeChecker_Common.logical_guard_uvar); + FStar_TypeChecker_Common.reason = + (p.FStar_TypeChecker_Common.reason); + FStar_TypeChecker_Common.loc = (p.FStar_TypeChecker_Common.loc); + FStar_TypeChecker_Common.rank = + (p.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = b + } + | FStar_TypeChecker_Common.CProb p -> + FStar_TypeChecker_Common.CProb + { + FStar_TypeChecker_Common.pid = (p.FStar_TypeChecker_Common.pid); + FStar_TypeChecker_Common.lhs = (p.FStar_TypeChecker_Common.lhs); + FStar_TypeChecker_Common.relation = + (p.FStar_TypeChecker_Common.relation); + FStar_TypeChecker_Common.rhs = (p.FStar_TypeChecker_Common.rhs); + FStar_TypeChecker_Common.element = + (p.FStar_TypeChecker_Common.element); + FStar_TypeChecker_Common.logical_guard = + (p.FStar_TypeChecker_Common.logical_guard); + FStar_TypeChecker_Common.logical_guard_uvar = + (p.FStar_TypeChecker_Common.logical_guard_uvar); + FStar_TypeChecker_Common.reason = + (p.FStar_TypeChecker_Common.reason); + FStar_TypeChecker_Common.loc = (p.FStar_TypeChecker_Common.loc); + FStar_TypeChecker_Common.rank = + (p.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = b + } let (is_top_level_prob : FStar_TypeChecker_Common.prob -> Prims.bool) = fun p -> (FStar_Compiler_List.length (p_reason p)) = Prims.int_one let (next_pid : unit -> Prims.int) = @@ -1308,7 +1379,8 @@ let mk_problem : (p_reason orig)); FStar_TypeChecker_Common.loc = (p_loc orig); FStar_TypeChecker_Common.rank = - FStar_Pervasives_Native.None + FStar_Pervasives_Native.None; + FStar_TypeChecker_Common.logical = (p_logical orig) } in (prob, wl1) let (mk_t_problem : @@ -1440,7 +1512,8 @@ let new_problem : FStar_TypeChecker_Common.reason = [reason]; FStar_TypeChecker_Common.loc = loc; FStar_TypeChecker_Common.rank = - FStar_Pervasives_Native.None + FStar_Pervasives_Native.None; + FStar_TypeChecker_Common.logical = false } in (prob, wl1) let (problem_using_guard : @@ -1473,7 +1546,8 @@ let (problem_using_guard : (p_reason orig)); FStar_TypeChecker_Common.loc = (p_loc orig); FStar_TypeChecker_Common.rank = - FStar_Pervasives_Native.None + FStar_Pervasives_Native.None; + FStar_TypeChecker_Common.logical = (p_logical orig) } in def_check_prob reason (FStar_TypeChecker_Common.TProb p); p let (guard_on_element : @@ -2880,88 +2954,6 @@ let (head_match : match_result -> match_result) = | MisMatch (i, j) -> MisMatch (i, j) | HeadMatch (true) -> HeadMatch true | uu___1 -> HeadMatch false -let (fv_delta_depth : - FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.fv -> FStar_Syntax_Syntax.delta_depth) - = - fun env -> - fun fv -> - let d = FStar_TypeChecker_Env.delta_depth_of_fv env fv in - match d with - | FStar_Syntax_Syntax.Delta_abstract d1 -> - let uu___ = - (let uu___1 = - FStar_Ident.string_of_lid env.FStar_TypeChecker_Env.curmodule in - let uu___2 = - FStar_Ident.nsstr - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - uu___1 = uu___2) && - (Prims.op_Negation env.FStar_TypeChecker_Env.is_iface) in - if uu___ then d1 else FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Delta_constant_at_level i when i > Prims.int_zero - -> - let uu___ = - FStar_TypeChecker_Env.lookup_definition - [FStar_TypeChecker_Env.Unfold - FStar_Syntax_Syntax.delta_constant] env - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - (match uu___ with - | FStar_Pervasives_Native.None -> - FStar_Syntax_Syntax.delta_constant - | uu___1 -> d) - | d1 -> d1 -let rec (delta_depth_of_term : - FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.delta_depth FStar_Pervasives_Native.option) - = - fun env -> - fun t -> - let t1 = FStar_Syntax_Util.unmeta t in - match t1.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_meta uu___ -> - FStar_Compiler_Effect.failwith "Impossible (delta depth of term)" - | FStar_Syntax_Syntax.Tm_delayed uu___ -> - FStar_Compiler_Effect.failwith "Impossible (delta depth of term)" - | FStar_Syntax_Syntax.Tm_lazy i -> - let uu___ = FStar_Syntax_Util.unfold_lazy i in - delta_depth_of_term env uu___ - | FStar_Syntax_Syntax.Tm_unknown -> FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Tm_bvar uu___ -> FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Tm_name uu___ -> FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Tm_uvar uu___ -> FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Tm_let uu___ -> FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Tm_match uu___ -> FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Tm_uinst (t2, uu___) -> - delta_depth_of_term env t2 - | FStar_Syntax_Syntax.Tm_ascribed - { FStar_Syntax_Syntax.tm = t2; FStar_Syntax_Syntax.asc = uu___; - FStar_Syntax_Syntax.eff_opt = uu___1;_} - -> delta_depth_of_term env t2 - | FStar_Syntax_Syntax.Tm_app - { FStar_Syntax_Syntax.hd = t2; FStar_Syntax_Syntax.args = uu___;_} - -> delta_depth_of_term env t2 - | FStar_Syntax_Syntax.Tm_refine - { - FStar_Syntax_Syntax.b = - { FStar_Syntax_Syntax.ppname = uu___; - FStar_Syntax_Syntax.index = uu___1; - FStar_Syntax_Syntax.sort = t2;_}; - FStar_Syntax_Syntax.phi = uu___2;_} - -> delta_depth_of_term env t2 - | FStar_Syntax_Syntax.Tm_constant uu___ -> - FStar_Pervasives_Native.Some FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Tm_type uu___ -> - FStar_Pervasives_Native.Some FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Tm_arrow uu___ -> - FStar_Pervasives_Native.Some FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Tm_quoted uu___ -> - FStar_Pervasives_Native.Some FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Tm_abs uu___ -> - FStar_Pervasives_Native.Some FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Tm_fvar fv -> - let uu___ = fv_delta_depth env fv in - FStar_Pervasives_Native.Some uu___ let (universe_has_max : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.universe -> Prims.bool) = fun env -> @@ -3038,10 +3030,10 @@ let rec (head_matches : else (let uu___3 = let uu___4 = - let uu___5 = fv_delta_depth env f in + let uu___5 = FStar_TypeChecker_Env.fv_delta_depth env f in FStar_Pervasives_Native.Some uu___5 in let uu___5 = - let uu___6 = fv_delta_depth env g in + let uu___6 = FStar_TypeChecker_Env.fv_delta_depth env g in FStar_Pervasives_Native.Some uu___6 in (uu___4, uu___5) in MisMatch uu___3) @@ -3122,281 +3114,310 @@ let rec (head_matches : | (FStar_Syntax_Syntax.Tm_abs uu___1, FStar_Syntax_Syntax.Tm_abs uu___2) -> HeadMatch true | uu___1 -> + let maybe_dd t = + let uu___2 = + let uu___3 = FStar_Syntax_Subst.compress t in + uu___3.FStar_Syntax_Syntax.n in + match uu___2 with + | FStar_Syntax_Syntax.Tm_unknown -> + FStar_Pervasives_Native.None + | FStar_Syntax_Syntax.Tm_bvar uu___3 -> + FStar_Pervasives_Native.None + | FStar_Syntax_Syntax.Tm_name uu___3 -> + FStar_Pervasives_Native.None + | FStar_Syntax_Syntax.Tm_uvar uu___3 -> + FStar_Pervasives_Native.None + | FStar_Syntax_Syntax.Tm_let uu___3 -> + FStar_Pervasives_Native.None + | FStar_Syntax_Syntax.Tm_match uu___3 -> + FStar_Pervasives_Native.None + | uu___3 -> + let uu___4 = + FStar_TypeChecker_Env.delta_depth_of_term env t in + FStar_Pervasives_Native.Some uu___4 in let uu___2 = - let uu___3 = delta_depth_of_term env t11 in - let uu___4 = delta_depth_of_term env t21 in (uu___3, uu___4) in + let uu___3 = maybe_dd t11 in + let uu___4 = maybe_dd t21 in (uu___3, uu___4) in MisMatch uu___2) let (head_matches_delta : FStar_TypeChecker_Env.env -> Prims.bool -> - FStar_Syntax_Syntax.typ -> + Prims.bool -> FStar_Syntax_Syntax.typ -> - (match_result * (FStar_Syntax_Syntax.typ * FStar_Syntax_Syntax.typ) - FStar_Pervasives_Native.option)) + FStar_Syntax_Syntax.typ -> + (match_result * (FStar_Syntax_Syntax.typ * + FStar_Syntax_Syntax.typ) FStar_Pervasives_Native.option)) = fun env -> - fun smt_ok -> - fun t1 -> - fun t2 -> - let maybe_inline t = - let head = - let uu___ = unrefine env t in FStar_Syntax_Util.head_of uu___ in - (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelDelta") in - if uu___1 - then - let uu___2 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term t in - let uu___3 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term head in - FStar_Compiler_Util.print2 "Head of %s is %s\n" uu___2 uu___3 - else ()); - (let uu___1 = - let uu___2 = FStar_Syntax_Util.un_uinst head in - uu___2.FStar_Syntax_Syntax.n in - match uu___1 with - | FStar_Syntax_Syntax.Tm_fvar fv -> + fun logical -> + fun smt_ok -> + fun t1 -> + fun t2 -> + let base_steps = + FStar_Compiler_List.op_At + (if logical then [FStar_TypeChecker_Env.UnfoldTac] else []) + [FStar_TypeChecker_Env.Primops; + FStar_TypeChecker_Env.Weak; + FStar_TypeChecker_Env.HNF] in + let maybe_inline t = + let head = + let uu___ = unrefine env t in FStar_Syntax_Util.head_of uu___ in + (let uu___1 = + FStar_TypeChecker_Env.debug env + (FStar_Options.Other "RelDelta") in + if uu___1 + then let uu___2 = - FStar_TypeChecker_Env.lookup_definition - [FStar_TypeChecker_Env.Unfold - FStar_Syntax_Syntax.delta_constant; - FStar_TypeChecker_Env.Eager_unfolding_only] env - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - (match uu___2 with - | FStar_Pervasives_Native.None -> - ((let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelDelta") in - if uu___4 - then - let uu___5 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term head in - FStar_Compiler_Util.print1 - "No definition found for %s\n" uu___5 - else ()); - FStar_Pervasives_Native.None) - | FStar_Pervasives_Native.Some uu___3 -> - let basic_steps = - [FStar_TypeChecker_Env.UnfoldUntil - FStar_Syntax_Syntax.delta_constant; - FStar_TypeChecker_Env.Weak; - FStar_TypeChecker_Env.HNF; - FStar_TypeChecker_Env.Primops; - FStar_TypeChecker_Env.Beta; - FStar_TypeChecker_Env.Eager_unfolding; - FStar_TypeChecker_Env.Iota] in - let steps = - if smt_ok - then basic_steps - else - (FStar_TypeChecker_Env.Exclude - FStar_TypeChecker_Env.Zeta) - :: basic_steps in - let t' = - norm_with_steps - "FStar.TypeChecker.Rel.norm_with_steps.1" steps env - t in - let uu___4 = - let uu___5 = FStar_Syntax_Util.eq_tm t t' in - uu___5 = FStar_Syntax_Util.Equal in - if uu___4 - then FStar_Pervasives_Native.None - else - ((let uu___7 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term + head in + FStar_Compiler_Util.print2 "Head of %s is %s\n" uu___2 + uu___3 + else ()); + (let uu___1 = + let uu___2 = FStar_Syntax_Util.un_uinst head in + uu___2.FStar_Syntax_Syntax.n in + match uu___1 with + | FStar_Syntax_Syntax.Tm_fvar fv -> + let uu___2 = + FStar_TypeChecker_Env.lookup_definition + [FStar_TypeChecker_Env.Unfold + FStar_Syntax_Syntax.delta_constant; + FStar_TypeChecker_Env.Eager_unfolding_only] env + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + (match uu___2 with + | FStar_Pervasives_Native.None -> + ((let uu___4 = FStar_TypeChecker_Env.debug env (FStar_Options.Other "RelDelta") in - if uu___7 + if uu___4 then - let uu___8 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term t in - let uu___9 = + let uu___5 = FStar_Class_Show.show - FStar_Syntax_Print.showable_term t' in - FStar_Compiler_Util.print2 "Inlined %s to %s\n" - uu___8 uu___9 + FStar_Syntax_Print.showable_term head in + FStar_Compiler_Util.print1 + "No definition found for %s\n" uu___5 else ()); - FStar_Pervasives_Native.Some t')) - | uu___2 -> FStar_Pervasives_Native.None) in - let success d r t11 t21 = - (r, - (if d > Prims.int_zero - then FStar_Pervasives_Native.Some (t11, t21) - else FStar_Pervasives_Native.None)) in - let fail d r t11 t21 = - (r, - (if d > Prims.int_zero - then FStar_Pervasives_Native.Some (t11, t21) - else FStar_Pervasives_Native.None)) in - let made_progress t t' = - let uu___ = - let uu___1 = - let uu___2 = FStar_Syntax_Util.head_and_args t in - FStar_Pervasives_Native.fst uu___2 in - let uu___2 = - let uu___3 = FStar_Syntax_Util.head_and_args t' in - FStar_Pervasives_Native.fst uu___3 in - (uu___1, uu___2) in - match uu___ with - | (head, head') -> + FStar_Pervasives_Native.None) + | FStar_Pervasives_Native.Some uu___3 -> + let basic_steps = + FStar_Compiler_List.op_At + (if logical + then [FStar_TypeChecker_Env.UnfoldTac] + else []) + [FStar_TypeChecker_Env.UnfoldUntil + FStar_Syntax_Syntax.delta_constant; + FStar_TypeChecker_Env.Weak; + FStar_TypeChecker_Env.HNF; + FStar_TypeChecker_Env.Primops; + FStar_TypeChecker_Env.Beta; + FStar_TypeChecker_Env.Eager_unfolding; + FStar_TypeChecker_Env.Iota] in + let steps = + if smt_ok + then basic_steps + else + (FStar_TypeChecker_Env.Exclude + FStar_TypeChecker_Env.Zeta) + :: basic_steps in + let t' = + norm_with_steps + "FStar.TypeChecker.Rel.norm_with_steps.1" steps + env t in + let uu___4 = + let uu___5 = FStar_Syntax_Util.eq_tm t t' in + uu___5 = FStar_Syntax_Util.Equal in + if uu___4 + then FStar_Pervasives_Native.None + else + ((let uu___7 = + FStar_TypeChecker_Env.debug env + (FStar_Options.Other "RelDelta") in + if uu___7 + then + let uu___8 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in + let uu___9 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t' in + FStar_Compiler_Util.print2 "Inlined %s to %s\n" + uu___8 uu___9 + else ()); + FStar_Pervasives_Native.Some t')) + | uu___2 -> FStar_Pervasives_Native.None) in + let success d r t11 t21 = + (r, + (if d > Prims.int_zero + then FStar_Pervasives_Native.Some (t11, t21) + else FStar_Pervasives_Native.None)) in + let fail d r t11 t21 = + (r, + (if d > Prims.int_zero + then FStar_Pervasives_Native.Some (t11, t21) + else FStar_Pervasives_Native.None)) in + let made_progress t t' = + let uu___ = let uu___1 = - let uu___2 = FStar_Syntax_Util.eq_tm head head' in - uu___2 = FStar_Syntax_Util.Equal in - Prims.op_Negation uu___1 in - let rec aux retry n_delta t11 t21 = - let r = head_matches env t11 t21 in + let uu___2 = FStar_Syntax_Util.head_and_args t in + FStar_Pervasives_Native.fst uu___2 in + let uu___2 = + let uu___3 = FStar_Syntax_Util.head_and_args t' in + FStar_Pervasives_Native.fst uu___3 in + (uu___1, uu___2) in + match uu___ with + | (head, head') -> + let uu___1 = + let uu___2 = FStar_Syntax_Util.eq_tm head head' in + uu___2 = FStar_Syntax_Util.Equal in + Prims.op_Negation uu___1 in + let rec aux retry n_delta t11 t21 = + let r = head_matches env t11 t21 in + (let uu___1 = + FStar_TypeChecker_Env.debug env + (FStar_Options.Other "RelDelta") in + if uu___1 + then + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t11 in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t21 in + let uu___4 = string_of_match_result r in + FStar_Compiler_Util.print3 "head_matches (%s, %s) = %s\n" + uu___2 uu___3 uu___4 + else ()); + (let reduce_one_and_try_again d1 d2 = + let d1_greater_than_d2 = + FStar_TypeChecker_Common.delta_depth_greater_than d1 d2 in + let uu___1 = + if d1_greater_than_d2 + then + let t1' = + normalize_refinement + ((FStar_TypeChecker_Env.UnfoldUntil d2) :: + base_steps) env t11 in + let uu___2 = made_progress t11 t1' in (t1', t21, uu___2) + else + (let t2' = + normalize_refinement + ((FStar_TypeChecker_Env.UnfoldUntil d1) :: + base_steps) env t21 in + let uu___3 = made_progress t21 t2' in + (t11, t2', uu___3)) in + match uu___1 with + | (t12, t22, made_progress1) -> + if made_progress1 + then aux retry (n_delta + Prims.int_one) t12 t22 + else fail n_delta r t12 t22 in + let reduce_both_and_try_again d r1 = + let uu___1 = FStar_TypeChecker_Common.decr_delta_depth d in + match uu___1 with + | FStar_Pervasives_Native.None -> fail n_delta r1 t11 t21 + | FStar_Pervasives_Native.Some d1 -> + let t1' = + normalize_refinement + ((FStar_TypeChecker_Env.UnfoldUntil d1) :: + base_steps) env t11 in + let t2' = + normalize_refinement + ((FStar_TypeChecker_Env.UnfoldUntil d1) :: + base_steps) env t21 in + let uu___2 = + (made_progress t11 t1') && (made_progress t21 t2') in + if uu___2 + then aux retry (n_delta + Prims.int_one) t1' t2' + else fail n_delta r1 t11 t21 in + match r with + | MisMatch + (FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.Delta_equational_at_level i), + FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.Delta_equational_at_level j)) + when + ((i > Prims.int_zero) || (j > Prims.int_zero)) && (i <> j) + -> + reduce_one_and_try_again + (FStar_Syntax_Syntax.Delta_equational_at_level i) + (FStar_Syntax_Syntax.Delta_equational_at_level j) + | MisMatch + (FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.Delta_equational_at_level uu___1), + uu___2) + -> + if Prims.op_Negation retry + then fail n_delta r t11 t21 + else + (let uu___4 = + let uu___5 = maybe_inline t11 in + let uu___6 = maybe_inline t21 in (uu___5, uu___6) in + match uu___4 with + | (FStar_Pervasives_Native.None, + FStar_Pervasives_Native.None) -> + fail n_delta r t11 t21 + | (FStar_Pervasives_Native.Some t12, + FStar_Pervasives_Native.None) -> + aux false (n_delta + Prims.int_one) t12 t21 + | (FStar_Pervasives_Native.None, + FStar_Pervasives_Native.Some t22) -> + aux false (n_delta + Prims.int_one) t11 t22 + | (FStar_Pervasives_Native.Some t12, + FStar_Pervasives_Native.Some t22) -> + aux false (n_delta + Prims.int_one) t12 t22) + | MisMatch + (uu___1, FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.Delta_equational_at_level uu___2)) + -> + if Prims.op_Negation retry + then fail n_delta r t11 t21 + else + (let uu___4 = + let uu___5 = maybe_inline t11 in + let uu___6 = maybe_inline t21 in (uu___5, uu___6) in + match uu___4 with + | (FStar_Pervasives_Native.None, + FStar_Pervasives_Native.None) -> + fail n_delta r t11 t21 + | (FStar_Pervasives_Native.Some t12, + FStar_Pervasives_Native.None) -> + aux false (n_delta + Prims.int_one) t12 t21 + | (FStar_Pervasives_Native.None, + FStar_Pervasives_Native.Some t22) -> + aux false (n_delta + Prims.int_one) t11 t22 + | (FStar_Pervasives_Native.Some t12, + FStar_Pervasives_Native.Some t22) -> + aux false (n_delta + Prims.int_one) t12 t22) + | MisMatch + (FStar_Pervasives_Native.Some d1, + FStar_Pervasives_Native.Some d2) + when d1 = d2 -> reduce_both_and_try_again d1 r + | MisMatch + (FStar_Pervasives_Native.Some d1, + FStar_Pervasives_Native.Some d2) + -> reduce_one_and_try_again d1 d2 + | MisMatch uu___1 -> fail n_delta r t11 t21 + | uu___1 -> success n_delta r t11 t21) in + let r = aux true Prims.int_zero t1 t2 in (let uu___1 = FStar_TypeChecker_Env.debug env (FStar_Options.Other "RelDelta") in if uu___1 then let uu___2 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term t11 in + FStar_Class_Show.show FStar_Syntax_Print.showable_term t1 in let uu___3 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term t21 in - let uu___4 = string_of_match_result r in - FStar_Compiler_Util.print3 "head_matches (%s, %s) = %s\n" - uu___2 uu___3 uu___4 + FStar_Class_Show.show FStar_Syntax_Print.showable_term t2 in + let uu___4 = + FStar_Class_Show.show + (FStar_Class_Show.show_tuple2 showable_match_result + (FStar_Class_Show.show_option + (FStar_Class_Show.show_tuple2 + FStar_Syntax_Print.showable_term + FStar_Syntax_Print.showable_term))) r in + FStar_Compiler_Util.print3 + "head_matches_delta (%s, %s) = %s\n" uu___2 uu___3 uu___4 else ()); - (let reduce_one_and_try_again d1 d2 = - let d1_greater_than_d2 = - FStar_TypeChecker_Common.delta_depth_greater_than d1 d2 in - let uu___1 = - if d1_greater_than_d2 - then - let t1' = - normalize_refinement - [FStar_TypeChecker_Env.UnfoldUntil d2; - FStar_TypeChecker_Env.Primops; - FStar_TypeChecker_Env.Weak; - FStar_TypeChecker_Env.HNF] env t11 in - let uu___2 = made_progress t11 t1' in (t1', t21, uu___2) - else - (let t2' = - normalize_refinement - [FStar_TypeChecker_Env.UnfoldUntil d1; - FStar_TypeChecker_Env.Primops; - FStar_TypeChecker_Env.Weak; - FStar_TypeChecker_Env.HNF] env t21 in - let uu___3 = made_progress t21 t2' in (t11, t2', uu___3)) in - match uu___1 with - | (t12, t22, made_progress1) -> - if made_progress1 - then aux retry (n_delta + Prims.int_one) t12 t22 - else fail n_delta r t12 t22 in - let reduce_both_and_try_again d r1 = - let uu___1 = FStar_TypeChecker_Common.decr_delta_depth d in - match uu___1 with - | FStar_Pervasives_Native.None -> fail n_delta r1 t11 t21 - | FStar_Pervasives_Native.Some d1 -> - let t1' = - normalize_refinement - [FStar_TypeChecker_Env.UnfoldUntil d1; - FStar_TypeChecker_Env.Primops; - FStar_TypeChecker_Env.Weak; - FStar_TypeChecker_Env.HNF] env t11 in - let t2' = - normalize_refinement - [FStar_TypeChecker_Env.UnfoldUntil d1; - FStar_TypeChecker_Env.Primops; - FStar_TypeChecker_Env.Weak; - FStar_TypeChecker_Env.HNF] env t21 in - let uu___2 = - (made_progress t11 t1') && (made_progress t21 t2') in - if uu___2 - then aux retry (n_delta + Prims.int_one) t1' t2' - else fail n_delta r1 t11 t21 in - match r with - | MisMatch - (FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_equational_at_level i), - FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_equational_at_level j)) - when - ((i > Prims.int_zero) || (j > Prims.int_zero)) && (i <> j) - -> - reduce_one_and_try_again - (FStar_Syntax_Syntax.Delta_equational_at_level i) - (FStar_Syntax_Syntax.Delta_equational_at_level j) - | MisMatch - (FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_equational_at_level uu___1), - uu___2) - -> - if Prims.op_Negation retry - then fail n_delta r t11 t21 - else - (let uu___4 = - let uu___5 = maybe_inline t11 in - let uu___6 = maybe_inline t21 in (uu___5, uu___6) in - match uu___4 with - | (FStar_Pervasives_Native.None, - FStar_Pervasives_Native.None) -> - fail n_delta r t11 t21 - | (FStar_Pervasives_Native.Some t12, - FStar_Pervasives_Native.None) -> - aux false (n_delta + Prims.int_one) t12 t21 - | (FStar_Pervasives_Native.None, - FStar_Pervasives_Native.Some t22) -> - aux false (n_delta + Prims.int_one) t11 t22 - | (FStar_Pervasives_Native.Some t12, - FStar_Pervasives_Native.Some t22) -> - aux false (n_delta + Prims.int_one) t12 t22) - | MisMatch - (uu___1, FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_equational_at_level uu___2)) - -> - if Prims.op_Negation retry - then fail n_delta r t11 t21 - else - (let uu___4 = - let uu___5 = maybe_inline t11 in - let uu___6 = maybe_inline t21 in (uu___5, uu___6) in - match uu___4 with - | (FStar_Pervasives_Native.None, - FStar_Pervasives_Native.None) -> - fail n_delta r t11 t21 - | (FStar_Pervasives_Native.Some t12, - FStar_Pervasives_Native.None) -> - aux false (n_delta + Prims.int_one) t12 t21 - | (FStar_Pervasives_Native.None, - FStar_Pervasives_Native.Some t22) -> - aux false (n_delta + Prims.int_one) t11 t22 - | (FStar_Pervasives_Native.Some t12, - FStar_Pervasives_Native.Some t22) -> - aux false (n_delta + Prims.int_one) t12 t22) - | MisMatch - (FStar_Pervasives_Native.Some d1, - FStar_Pervasives_Native.Some d2) - when d1 = d2 -> reduce_both_and_try_again d1 r - | MisMatch - (FStar_Pervasives_Native.Some d1, - FStar_Pervasives_Native.Some d2) - -> reduce_one_and_try_again d1 d2 - | MisMatch uu___1 -> fail n_delta r t11 t21 - | uu___1 -> success n_delta r t11 t21) in - let r = aux true Prims.int_zero t1 t2 in - (let uu___1 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "RelDelta") in - if uu___1 - then - let uu___2 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term t1 in - let uu___3 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term t2 in - let uu___4 = - FStar_Class_Show.show - (FStar_Class_Show.show_tuple2 showable_match_result - (FStar_Class_Show.show_option - (FStar_Class_Show.show_tuple2 - FStar_Syntax_Print.showable_term - FStar_Syntax_Print.showable_term))) r in - FStar_Compiler_Util.print3 "head_matches_delta (%s, %s) = %s\n" - uu___2 uu___3 uu___4 - else ()); - r + r let (kind_type : FStar_Syntax_Syntax.binders -> FStar_Compiler_Range_Type.range -> FStar_Syntax_Syntax.typ) @@ -3446,7 +3467,9 @@ let (compress_tprob : (p.FStar_TypeChecker_Common.logical_guard_uvar); FStar_TypeChecker_Common.reason = (p.FStar_TypeChecker_Common.reason); FStar_TypeChecker_Common.loc = (p.FStar_TypeChecker_Common.loc); - FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank) + FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (p.FStar_TypeChecker_Common.logical) } let (compress_cprob : worklist -> @@ -3478,7 +3501,9 @@ let (compress_cprob : (p.FStar_TypeChecker_Common.logical_guard_uvar); FStar_TypeChecker_Common.reason = (p.FStar_TypeChecker_Common.reason); FStar_TypeChecker_Common.loc = (p.FStar_TypeChecker_Common.loc); - FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank) + FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (p.FStar_TypeChecker_Common.logical) } let (compress_prob : worklist -> FStar_TypeChecker_Common.prob -> FStar_TypeChecker_Common.prob) @@ -3557,7 +3582,9 @@ let (rank : FStar_TypeChecker_Common.loc = (tp.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (tp.FStar_TypeChecker_Common.rank) + (tp.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (tp.FStar_TypeChecker_Common.logical) }) | (FStar_Syntax_Syntax.Tm_uvar uu___3, FStar_Syntax_Syntax.Tm_type uu___4) -> @@ -3582,7 +3609,9 @@ let (rank : FStar_TypeChecker_Common.loc = (tp.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (tp.FStar_TypeChecker_Common.rank) + (tp.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (tp.FStar_TypeChecker_Common.logical) }) | (FStar_Syntax_Syntax.Tm_type uu___3, FStar_Syntax_Syntax.Tm_uvar uu___4) -> @@ -3607,7 +3636,9 @@ let (rank : FStar_TypeChecker_Common.loc = (tp.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (tp.FStar_TypeChecker_Common.rank) + (tp.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (tp.FStar_TypeChecker_Common.logical) }) | (uu___3, FStar_Syntax_Syntax.Tm_uvar uu___4) -> (FStar_TypeChecker_Common.Rigid_flex, tp) @@ -3641,7 +3672,9 @@ let (rank : FStar_TypeChecker_Common.loc = (tp1.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (FStar_Pervasives_Native.Some rank1) + (FStar_Pervasives_Native.Some rank1); + FStar_TypeChecker_Common.logical = + (tp1.FStar_TypeChecker_Common.logical) }))))) | FStar_TypeChecker_Common.CProb cp -> (FStar_TypeChecker_Common.Rigid_rigid, @@ -3667,7 +3700,9 @@ let (rank : (cp.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = (FStar_Pervasives_Native.Some - FStar_TypeChecker_Common.Rigid_rigid) + FStar_TypeChecker_Common.Rigid_rigid); + FStar_TypeChecker_Common.logical = + (cp.FStar_TypeChecker_Common.logical) })) let (next_prob : worklist -> @@ -5201,7 +5236,9 @@ let rec (solve : worklist -> solution) = FStar_TypeChecker_Common.loc = (tp.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (tp.FStar_TypeChecker_Common.rank) + (tp.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (tp.FStar_TypeChecker_Common.logical) } probs1 else solve_rigid_flex_or_flex_rigid_subtyping rank1 tp @@ -5478,8 +5515,8 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : else ()); (let uu___2 = head_matches_delta - (p_env wl2 (FStar_TypeChecker_Common.TProb tp)) wl2.smt_ok - t1 t2 in + (p_env wl2 (FStar_TypeChecker_Common.TProb tp)) + tp.FStar_TypeChecker_Common.logical wl2.smt_ok t1 t2 in match uu___2 with | (mr, ts1) -> (match mr with @@ -5831,7 +5868,9 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : FStar_TypeChecker_Common.loc = (tp.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (tp.FStar_TypeChecker_Common.rank) + (tp.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (tp.FStar_TypeChecker_Common.logical) }] wl in solve uu___5) | uu___3 -> @@ -7893,7 +7932,7 @@ and (solve_t_flex_flex : let uu___21 = let uu___22 = FStar_Class_Show.show - uu___76 wl.defer_ok in + uu___78 wl.defer_ok in FStar_Compiler_Util.format1 "flex-flex: occurs\n defer_ok=%s\n" uu___22 in @@ -8221,7 +8260,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl1 else solve_head_then wl1 @@ -8481,7 +8522,10 @@ and (solve_t' : tprob -> worklist -> solution) = (torig.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (torig.FStar_TypeChecker_Common.rank) + (torig.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical + = + (torig.FStar_TypeChecker_Common.logical) } in ((let uu___19 = @@ -8508,13 +8552,10 @@ and (solve_t' : tprob -> worklist -> solution) = solve_sub_probs env1 wl2)) in let d = let uu___9 = - delta_depth_of_term env head1 in - match uu___9 with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some d1 -> - FStar_TypeChecker_Common.decr_delta_depth - d1 in + FStar_TypeChecker_Env.delta_depth_of_term + env head1 in + FStar_TypeChecker_Common.decr_delta_depth + uu___9 in let treat_as_injective = let uu___9 = let uu___10 = @@ -8566,7 +8607,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl1)))))) in let try_match_heuristic orig wl1 s1 s2 t1t2_opt = let env = p_env wl1 orig in @@ -8838,7 +8881,7 @@ and (solve_t' : tprob -> worklist -> solution) = | (uu___14, uu___15, t') -> let uu___16 = head_matches_delta (p_env wl1 orig) - wl1.smt_ok s t' in + (p_logical orig) wl1.smt_ok s t' in (match uu___16 with | (FullMatch, uu___17) -> true | (HeadMatch uu___17, uu___18) -> true @@ -8968,7 +9011,7 @@ and (solve_t' : tprob -> worklist -> solution) = | (uu___14, uu___15, t') -> let uu___16 = head_matches_delta (p_env wl1 orig) - wl1.smt_ok s t' in + (p_logical orig) wl1.smt_ok s t' in (match uu___16 with | (FullMatch, uu___17) -> true | (HeadMatch uu___17, uu___18) -> true @@ -9049,7 +9092,9 @@ and (solve_t' : tprob -> worklist -> solution) = "rigid_rigid_delta of %s-%s (%s, %s)\n" uu___3 uu___4 uu___5 uu___6 else ()); - (let uu___2 = head_matches_delta (p_env wl1 orig) wl1.smt_ok t1 t2 in + (let uu___2 = + head_matches_delta (p_env wl1 orig) (p_logical orig) wl1.smt_ok + t1 t2 in match uu___2 with | (m, o) -> (match (m, o) with @@ -9186,7 +9231,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl1 | FStar_Pervasives_Native.None -> let uu___7 = @@ -9218,38 +9265,22 @@ and (solve_t' : tprob -> worklist -> solution) = head1 in let uu___12 = let uu___13 = - let uu___14 = - delta_depth_of_term wl1.tcenv - head1 in - FStar_Compiler_Util.bind_opt - uu___14 - (fun x -> - let uu___15 = - FStar_Class_Show.show - FStar_Syntax_Syntax.showable_delta_depth - x in - FStar_Pervasives_Native.Some - uu___15) in - FStar_Compiler_Util.dflt "" uu___13 in + FStar_TypeChecker_Env.delta_depth_of_term + wl1.tcenv head1 in + FStar_Class_Show.show + FStar_Syntax_Syntax.showable_delta_depth + uu___13 in let uu___13 = FStar_Class_Show.show FStar_Syntax_Print.showable_term head2 in let uu___14 = let uu___15 = - let uu___16 = - delta_depth_of_term wl1.tcenv - head2 in - FStar_Compiler_Util.bind_opt - uu___16 - (fun x -> - let uu___17 = - FStar_Class_Show.show - FStar_Syntax_Syntax.showable_delta_depth - x in - FStar_Pervasives_Native.Some - uu___17) in - FStar_Compiler_Util.dflt "" uu___15 in + FStar_TypeChecker_Env.delta_depth_of_term + wl1.tcenv head2 in + FStar_Class_Show.show + FStar_Syntax_Syntax.showable_delta_depth + uu___15 in FStar_Compiler_Util.format4 "head mismatch (%s (%s) vs %s (%s))" uu___11 uu___12 uu___13 uu___14) in @@ -9301,7 +9332,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl1 | (HeadMatch need_unif, FStar_Pervasives_Native.None) -> rigid_heads_match need_unif torig wl1 t1 t2 @@ -9391,7 +9424,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } in solve_t' uu___9 wl | (FStar_Syntax_Syntax.Tm_meta uu___7, uu___8) -> @@ -9416,7 +9451,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } in solve_t' uu___9 wl | (uu___7, FStar_Syntax_Syntax.Tm_ascribed uu___8) -> @@ -9441,7 +9478,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } in solve_t' uu___9 wl | (uu___7, FStar_Syntax_Syntax.Tm_meta uu___8) -> @@ -9466,7 +9505,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } in solve_t' uu___9 wl | (FStar_Syntax_Syntax.Tm_quoted (t11, uu___7), @@ -9570,7 +9611,7 @@ and (solve_t' : tprob -> worklist -> solution) = let env = p_env wl (FStar_TypeChecker_Common.TProb problem) in let uu___7 = let uu___8 = - head_matches_delta env wl.smt_ok + head_matches_delta env false wl.smt_ok x1.FStar_Syntax_Syntax.sort x2.FStar_Syntax_Syntax.sort in match uu___8 with | (FullMatch, FStar_Pervasives_Native.Some (t11, t21)) -> @@ -9764,13 +9805,15 @@ and (solve_t' : tprob -> worklist -> solution) = "refinement formula" in (match uu___12 with | (ref_prob, wl2) -> + let ref_prob1 = + set_logical true ref_prob in let tx = FStar_Syntax_Unionfind.new_transaction () in let uu___13 = solve { - attempting = [ref_prob]; + attempting = [ref_prob1]; wl_deferred = []; wl_deferred_to_tac = (wl2.wl_deferred_to_tac); @@ -9812,7 +9855,7 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___16 = guard_on_element wl2 problem x13 - (p_guard ref_prob) in + (p_guard ref_prob1) in FStar_Syntax_Util.mk_conj (p_guard base_prob) uu___16 in @@ -10005,7 +10048,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl | (FStar_Syntax_Syntax.Tm_app { @@ -10039,7 +10084,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl | (uu___7, FStar_Syntax_Syntax.Tm_uvar uu___8) -> let uu___9 = @@ -10098,7 +10145,8 @@ and (solve_t' : tprob -> worklist -> solution) = solve_t_flex_rigid_eq orig wl1 flex t_abs) else (let uu___11 = - head_matches_delta env wl.smt_ok not_abs t_abs in + head_matches_delta env false wl.smt_ok not_abs + t_abs in match uu___11 with | (HeadMatch uu___12, FStar_Pervasives_Native.Some (not_abs', uu___13)) -> @@ -10121,7 +10169,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl | uu___12 -> let uu___13 = @@ -10159,7 +10209,8 @@ and (solve_t' : tprob -> worklist -> solution) = solve_t_flex_rigid_eq orig wl1 flex t_abs) else (let uu___11 = - head_matches_delta env wl.smt_ok not_abs t_abs in + head_matches_delta env false wl.smt_ok not_abs + t_abs in match uu___11 with | (HeadMatch uu___12, FStar_Pervasives_Native.Some (not_abs', uu___13)) -> @@ -10182,7 +10233,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl | uu___12 -> let uu___13 = @@ -10231,7 +10284,8 @@ and (solve_t' : tprob -> worklist -> solution) = solve_t_flex_rigid_eq orig wl1 flex t_abs) else (let uu___11 = - head_matches_delta env wl.smt_ok not_abs t_abs in + head_matches_delta env false wl.smt_ok not_abs + t_abs in match uu___11 with | (HeadMatch uu___12, FStar_Pervasives_Native.Some (not_abs', uu___13)) -> @@ -10254,7 +10308,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl | uu___12 -> let uu___13 = @@ -10292,7 +10348,8 @@ and (solve_t' : tprob -> worklist -> solution) = solve_t_flex_rigid_eq orig wl1 flex t_abs) else (let uu___11 = - head_matches_delta env wl.smt_ok not_abs t_abs in + head_matches_delta env false wl.smt_ok not_abs + t_abs in match uu___11 with | (HeadMatch uu___12, FStar_Pervasives_Native.Some (not_abs', uu___13)) -> @@ -10315,7 +10372,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl | uu___12 -> let uu___13 = @@ -10367,7 +10426,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl | (uu___7, FStar_Syntax_Syntax.Tm_refine uu___8) -> let t11 = @@ -10393,7 +10454,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl | (FStar_Syntax_Syntax.Tm_match { FStar_Syntax_Syntax.scrutinee = s1; @@ -12482,7 +12545,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } in solve_t' uu___7 wl | uu___7 -> @@ -13380,7 +13445,9 @@ and (solve_c : FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } in solve_c uu___6 wl | (FStar_Syntax_Syntax.Total uu___4, FStar_Syntax_Syntax.Comp @@ -13409,7 +13476,9 @@ and (solve_c : FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } in solve_c uu___6 wl | (FStar_Syntax_Syntax.Comp uu___4, FStar_Syntax_Syntax.GTotal @@ -13438,7 +13507,9 @@ and (solve_c : FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } in solve_c uu___6 wl | (FStar_Syntax_Syntax.Comp uu___4, FStar_Syntax_Syntax.Total @@ -13467,7 +13538,9 @@ and (solve_c : FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } in solve_c uu___6 wl | (FStar_Syntax_Syntax.Comp uu___4, FStar_Syntax_Syntax.Comp @@ -14369,7 +14442,7 @@ let (try_solve_deferred_constraints : (FStar_Options.Other "Rel") in if uu___4 then - let uu___5 = FStar_Class_Show.show uu___76 defer_ok in + let uu___5 = FStar_Class_Show.show uu___78 defer_ok in let uu___6 = FStar_Class_Show.show (FStar_Class_Show.printableshow diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml index 676e915c74f..58240a147d0 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml @@ -2364,8 +2364,6 @@ let (mk_discriminator_and_indexed_projectors : let uu___1 = FStar_Ident.set_lid_range disc_name p in FStar_Syntax_Syntax.fvar_with_dd uu___1 - (FStar_Syntax_Syntax.Delta_equational_at_level - Prims.int_one) FStar_Pervasives_Native.None in let uu___1 = let uu___2 = @@ -2622,9 +2620,6 @@ let (mk_discriminator_and_indexed_projectors : } in FStar_Syntax_Syntax.Tm_match uu___5 in FStar_Syntax_Syntax.mk uu___4 p) in - let dd = - FStar_Syntax_Syntax.Delta_equational_at_level - Prims.int_one in let imp = FStar_Syntax_Util.abs binders body FStar_Pervasives_Native.None in @@ -2636,7 +2631,7 @@ let (mk_discriminator_and_indexed_projectors : let uu___3 = let uu___4 = FStar_Syntax_Syntax.lid_and_dd_as_fv - discriminator_name dd + discriminator_name FStar_Pervasives_Native.None in FStar_Pervasives.Inr uu___4 in let uu___4 = @@ -3036,7 +3031,7 @@ let (mk_discriminator_and_indexed_projectors : let uu___9 = let uu___10 = FStar_Syntax_Syntax.lid_and_dd_as_fv - field_name dd + field_name FStar_Pervasives_Native.None in FStar_Pervasives.Inr uu___10 in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml index aeadfe2bf63..5852a96f007 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml @@ -3188,94 +3188,93 @@ and (tc_maybe_toplevel_term : { FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar { FStar_Syntax_Syntax.fv_name = uu___2; - FStar_Syntax_Syntax.fv_delta = uu___3; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Unresolved_constructor uc);_}; - FStar_Syntax_Syntax.pos = uu___4; - FStar_Syntax_Syntax.vars = uu___5; - FStar_Syntax_Syntax.hash_code = uu___6;_}; + FStar_Syntax_Syntax.pos = uu___3; + FStar_Syntax_Syntax.vars = uu___4; + FStar_Syntax_Syntax.hash_code = uu___5;_}; FStar_Syntax_Syntax.args = args;_} -> - let uu___7 = - let uu___8 = + let uu___6 = + let uu___7 = if uc.FStar_Syntax_Syntax.uc_base_term then match args with - | (b, uu___9)::rest -> + | (b, uu___8)::rest -> ((FStar_Pervasives_Native.Some b), rest) - | uu___9 -> FStar_Compiler_Effect.failwith "Impossible" + | uu___8 -> FStar_Compiler_Effect.failwith "Impossible" else (FStar_Pervasives_Native.None, args) in - match uu___8 with + match uu___7 with | (base_term, fields) -> if (FStar_Compiler_List.length uc.FStar_Syntax_Syntax.uc_fields) <> (FStar_Compiler_List.length fields) then - let uu___9 = - let uu___10 = - let uu___11 = + let uu___8 = + let uu___9 = + let uu___10 = FStar_Class_Show.show (FStar_Class_Show.printableshow FStar_Class_Printable.printable_nat) (FStar_Compiler_List.length uc.FStar_Syntax_Syntax.uc_fields) in - let uu___12 = + let uu___11 = FStar_Class_Show.show (FStar_Class_Show.printableshow FStar_Class_Printable.printable_nat) (FStar_Compiler_List.length fields) in FStar_Compiler_Util.format2 "Could not resolve constructor; expected %s fields but only found %s" - uu___11 uu___12 in - (FStar_Errors_Codes.Fatal_IdentifierNotFound, uu___10) in - FStar_Errors.raise_error uu___9 + uu___10 uu___11 in + (FStar_Errors_Codes.Fatal_IdentifierNotFound, uu___9) in + FStar_Errors.raise_error uu___8 top.FStar_Syntax_Syntax.pos else - (let uu___10 = - let uu___11 = + (let uu___9 = + let uu___10 = FStar_Compiler_List.map FStar_Pervasives_Native.fst fields in FStar_Compiler_List.zip - uc.FStar_Syntax_Syntax.uc_fields uu___11 in - (base_term, uu___10)) in - (match uu___7 with + uc.FStar_Syntax_Syntax.uc_fields uu___10 in + (base_term, uu___9)) in + (match uu___6 with | (base_term, uc_fields) -> - let uu___8 = - let uu___9 = FStar_TypeChecker_Env.expected_typ env1 in - match uu___9 with - | FStar_Pervasives_Native.Some (t, uu___10) -> - let uu___11 = + let uu___7 = + let uu___8 = FStar_TypeChecker_Env.expected_typ env1 in + match uu___8 with + | FStar_Pervasives_Native.Some (t, uu___9) -> + let uu___10 = FStar_TypeChecker_Util.find_record_or_dc_from_typ env1 (FStar_Pervasives_Native.Some t) uc top.FStar_Syntax_Syntax.pos in - (uu___11, + (uu___10, (FStar_Pervasives_Native.Some (FStar_Pervasives.Inl t))) | FStar_Pervasives_Native.None -> (match base_term with | FStar_Pervasives_Native.Some e1 -> - let uu___10 = tc_term env1 e1 in - (match uu___10 with - | (uu___11, lc, uu___12) -> - let uu___13 = + let uu___9 = tc_term env1 e1 in + (match uu___9 with + | (uu___10, lc, uu___11) -> + let uu___12 = FStar_TypeChecker_Util.find_record_or_dc_from_typ env1 (FStar_Pervasives_Native.Some (lc.FStar_TypeChecker_Common.res_typ)) uc top.FStar_Syntax_Syntax.pos in - (uu___13, + (uu___12, (FStar_Pervasives_Native.Some (FStar_Pervasives.Inr (lc.FStar_TypeChecker_Common.res_typ))))) | FStar_Pervasives_Native.None -> - let uu___10 = + let uu___9 = FStar_TypeChecker_Util.find_record_or_dc_from_typ env1 FStar_Pervasives_Native.None uc top.FStar_Syntax_Syntax.pos in - (uu___10, FStar_Pervasives_Native.None)) in - (match uu___8 with + (uu___9, FStar_Pervasives_Native.None)) in + (match uu___7 with | ((rdc, constrname, constructor), topt) -> let rdc1 = rdc in let constructor1 = @@ -3292,10 +3291,10 @@ and (tc_maybe_toplevel_term : (constrname, i)) else FStar_Pervasives_Native.None in let candidate = - let uu___9 = + let uu___8 = FStar_Ident.set_lid_range projname x.FStar_Syntax_Syntax.pos in - FStar_Syntax_Syntax.fvar uu___9 qual in + FStar_Syntax_Syntax.fvar uu___8 qual in FStar_Syntax_Syntax.mk_Tm_app candidate [(x, FStar_Pervasives_Native.None)] x.FStar_Syntax_Syntax.pos in @@ -3305,9 +3304,9 @@ and (tc_maybe_toplevel_term : (fun field_name -> match base_term with | FStar_Pervasives_Native.Some x -> - let uu___9 = mk_field_projector field_name x in - FStar_Pervasives_Native.Some uu___9 - | uu___9 -> FStar_Pervasives_Native.None) + let uu___8 = mk_field_projector field_name x in + FStar_Pervasives_Native.Some uu___8 + | uu___8 -> FStar_Pervasives_Native.None) top.FStar_Syntax_Syntax.pos in let args1 = FStar_Compiler_List.map @@ -3325,27 +3324,26 @@ and (tc_maybe_toplevel_term : FStar_Syntax_Syntax.fv_name = { FStar_Syntax_Syntax.v = field_name; FStar_Syntax_Syntax.p = uu___2;_}; - FStar_Syntax_Syntax.fv_delta = uu___3; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Unresolved_projector candidate);_}; - FStar_Syntax_Syntax.pos = uu___4; - FStar_Syntax_Syntax.vars = uu___5; - FStar_Syntax_Syntax.hash_code = uu___6;_}; + FStar_Syntax_Syntax.pos = uu___3; + FStar_Syntax_Syntax.vars = uu___4; + FStar_Syntax_Syntax.hash_code = uu___5;_}; FStar_Syntax_Syntax.args = (e1, FStar_Pervasives_Native.None)::rest;_} -> let proceed_with choice = match choice with | FStar_Pervasives_Native.None -> - let uu___7 = - let uu___8 = - let uu___9 = FStar_Ident.string_of_lid field_name in + let uu___6 = + let uu___7 = + let uu___8 = FStar_Ident.string_of_lid field_name in FStar_Compiler_Util.format1 - "Field name %s could not be resolved" uu___9 in - (FStar_Errors_Codes.Fatal_IdentifierNotFound, uu___8) in - let uu___8 = FStar_Ident.range_of_lid field_name in - FStar_Errors.raise_error uu___7 uu___8 + "Field name %s could not be resolved" uu___8 in + (FStar_Errors_Codes.Fatal_IdentifierNotFound, uu___7) in + let uu___7 = FStar_Ident.range_of_lid field_name in + FStar_Errors.raise_error uu___6 uu___7 | FStar_Pervasives_Native.Some choice1 -> let f = FStar_Syntax_Syntax.fv_to_tm choice1 in let term = @@ -3353,55 +3351,55 @@ and (tc_maybe_toplevel_term : ((e1, FStar_Pervasives_Native.None) :: rest) top.FStar_Syntax_Syntax.pos in tc_term env1 term in - let uu___7 = - let uu___8 = FStar_TypeChecker_Env.clear_expected_typ env1 in - match uu___8 with | (env2, uu___9) -> tc_term env2 e1 in - (match uu___7 with - | (uu___8, lc, uu___9) -> + let uu___6 = + let uu___7 = FStar_TypeChecker_Env.clear_expected_typ env1 in + match uu___7 with | (env2, uu___8) -> tc_term env2 e1 in + (match uu___6 with + | (uu___7, lc, uu___8) -> let t0 = FStar_TypeChecker_Normalize.unfold_whnf' [FStar_TypeChecker_Env.Unascribe; FStar_TypeChecker_Env.Unmeta; FStar_TypeChecker_Env.Unrefine] env1 lc.FStar_TypeChecker_Common.res_typ in - let uu___10 = FStar_Syntax_Util.head_and_args t0 in - (match uu___10 with - | (thead, uu___11) -> - ((let uu___13 = + let uu___9 = FStar_Syntax_Util.head_and_args t0 in + (match uu___9 with + | (thead, uu___10) -> + ((let uu___12 = FStar_TypeChecker_Env.debug env1 (FStar_Options.Other "RFD") in - if uu___13 + if uu___12 then - let uu___14 = + let uu___13 = FStar_Syntax_Print.term_to_string lc.FStar_TypeChecker_Common.res_typ in - let uu___15 = FStar_Syntax_Print.term_to_string t0 in - let uu___16 = + let uu___14 = FStar_Syntax_Print.term_to_string t0 in + let uu___15 = FStar_Syntax_Print.term_to_string thead in FStar_Compiler_Util.print3 "Got lc.res_typ=%s; t0 = %s; thead = %s\n" - uu___14 uu___15 uu___16 + uu___13 uu___14 uu___15 else ()); - (let uu___13 = - let uu___14 = - let uu___15 = FStar_Syntax_Util.un_uinst thead in - FStar_Syntax_Subst.compress uu___15 in - uu___14.FStar_Syntax_Syntax.n in - match uu___13 with + (let uu___12 = + let uu___13 = + let uu___14 = FStar_Syntax_Util.un_uinst thead in + FStar_Syntax_Subst.compress uu___14 in + uu___13.FStar_Syntax_Syntax.n in + match uu___12 with | FStar_Syntax_Syntax.Tm_fvar type_name -> - let uu___14 = + let uu___13 = FStar_TypeChecker_Util.try_lookup_record_type env1 (type_name.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - (match uu___14 with + (match uu___13 with | FStar_Pervasives_Native.None -> proceed_with candidate | FStar_Pervasives_Native.Some rdc -> let i = FStar_Compiler_List.tryFind - (fun uu___15 -> - match uu___15 with - | (i1, uu___16) -> + (fun uu___14 -> + match uu___14 with + | (i1, uu___15) -> FStar_TypeChecker_Util.field_name_matches field_name rdc i1) rdc.FStar_Syntax_DsEnv.fields in @@ -3409,15 +3407,15 @@ and (tc_maybe_toplevel_term : | FStar_Pervasives_Native.None -> proceed_with candidate | FStar_Pervasives_Native.Some - (i1, uu___15) -> + (i1, uu___14) -> let constrname = - let uu___16 = - let uu___17 = + let uu___15 = + let uu___16 = FStar_Ident.ns_of_lid rdc.FStar_Syntax_DsEnv.typename in - FStar_Compiler_List.op_At uu___17 + FStar_Compiler_List.op_At uu___16 [rdc.FStar_Syntax_DsEnv.constrname] in - FStar_Ident.lid_of_ids uu___16 in + FStar_Ident.lid_of_ids uu___15 in let projname = FStar_Syntax_Util.mk_field_projector_name_from_ident constrname i1 in @@ -3429,17 +3427,17 @@ and (tc_maybe_toplevel_term : (constrname, i1)) else FStar_Pervasives_Native.None in let choice = - let uu___16 = - let uu___17 = + let uu___15 = + let uu___16 = FStar_Ident.range_of_lid field_name in FStar_Ident.set_lid_range projname - uu___17 in - FStar_Syntax_Syntax.lid_as_fv uu___16 + uu___16 in + FStar_Syntax_Syntax.lid_as_fv uu___15 qual in proceed_with (FStar_Pervasives_Native.Some choice))) - | uu___14 -> proceed_with candidate)))) + | uu___13 -> proceed_with candidate)))) | FStar_Syntax_Syntax.Tm_app { FStar_Syntax_Syntax.hd = head; FStar_Syntax_Syntax.args = @@ -8801,17 +8799,16 @@ and (tc_pat : FStar_TypeChecker_Env.trivial_guard, false)))))) | FStar_Syntax_Syntax.Pat_cons ({ FStar_Syntax_Syntax.fv_name = uu___1; - FStar_Syntax_Syntax.fv_delta = uu___2; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Unresolved_constructor uc);_}, us_opt, sub_pats) -> - let uu___3 = + let uu___2 = FStar_TypeChecker_Util.find_record_or_dc_from_typ env1 (FStar_Pervasives_Native.Some t) uc p.FStar_Syntax_Syntax.p in - (match uu___3 with - | (rdc, uu___4, constructor_fv) -> + (match uu___2 with + | (rdc, uu___3, constructor_fv) -> let f_sub_pats = FStar_Compiler_List.zip uc.FStar_Syntax_Syntax.uc_fields sub_pats in @@ -8820,18 +8817,18 @@ and (tc_pat : uc (FStar_Pervasives_Native.Some (FStar_Pervasives.Inl t)) rdc f_sub_pats - (fun uu___5 -> + (fun uu___4 -> let x = FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None FStar_Syntax_Syntax.tun in - let uu___6 = - let uu___7 = + let uu___5 = + let uu___6 = FStar_Syntax_Syntax.withinfo (FStar_Syntax_Syntax.Pat_var x) p.FStar_Syntax_Syntax.p in - (uu___7, false) in - FStar_Pervasives_Native.Some uu___6) + (uu___6, false) in + FStar_Pervasives_Native.Some uu___5) p.FStar_Syntax_Syntax.p in let p1 = { From 03d1b17e6720d2bc54315f93f7e7cd0865a2c614 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Fri, 26 Apr 2024 17:20:16 -0700 Subject: [PATCH 119/239] adding an injective_type_params field to Sig_inductive and Sig_datacon --- .../fstar-lib/generated/FStar_CheckedFiles.ml | 2 +- .../generated/FStar_Extraction_ML_Modul.ml | 119 +- .../generated/FStar_Extraction_ML_RegEmb.ml | 305 +-- .../generated/FStar_Reflection_V1_Builtins.ml | 86 +- .../generated/FStar_Reflection_V2_Builtins.ml | 49 +- .../generated/FStar_SMTEncoding_Encode.ml | 1992 +++++++---------- .../fstar-lib/generated/FStar_Syntax_DsEnv.ml | 202 +- .../generated/FStar_Syntax_MutRecTy.ml | 16 +- .../fstar-lib/generated/FStar_Syntax_Print.ml | 56 +- .../generated/FStar_Syntax_Resugar.ml | 136 +- .../generated/FStar_Syntax_Syntax.ml | 59 +- .../fstar-lib/generated/FStar_Syntax_Util.ml | 6 +- .../generated/FStar_Syntax_VisitM.ml | 15 +- .../generated/FStar_Tactics_V1_Basic.ml | 348 +-- .../generated/FStar_Tactics_V2_Basic.ml | 356 +-- .../generated/FStar_ToSyntax_ToSyntax.ml | 259 ++- .../generated/FStar_TypeChecker_Cfg.ml | 4 +- .../generated/FStar_TypeChecker_Env.ml | 246 +- .../generated/FStar_TypeChecker_NBETerm.ml | 3 +- .../generated/FStar_TypeChecker_Normalize.ml | 17 +- .../generated/FStar_TypeChecker_Positivity.ml | 47 +- .../generated/FStar_TypeChecker_Tc.ml | 18 +- .../FStar_TypeChecker_TcInductive.ml | 1083 ++++++--- .../FStar_TypeChecker_TermEqAndSimplify.ml | 8 +- .../generated/FStar_TypeChecker_Util.ml | 34 +- src/fstar/FStar.CheckedFiles.fst | 2 +- .../FStar.Reflection.V1.Builtins.fst | 7 +- .../FStar.Reflection.V2.Builtins.fst | 7 +- src/smtencoding/FStar.SMTEncoding.Encode.fst | 121 +- src/syntax/FStar.Syntax.MutRecTy.fst | 14 +- src/syntax/FStar.Syntax.Syntax.fsti | 2 + src/syntax/FStar.Syntax.VisitM.fst | 8 +- src/tosyntax/FStar.ToSyntax.ToSyntax.fst | 20 +- src/typechecker/FStar.TypeChecker.Cfg.fst | 2 +- src/typechecker/FStar.TypeChecker.Env.fst | 5 +- src/typechecker/FStar.TypeChecker.Env.fsti | 2 +- src/typechecker/FStar.TypeChecker.NBETerm.fst | 2 +- .../FStar.TypeChecker.Normalize.fst | 11 +- .../FStar.TypeChecker.Positivity.fst | 5 +- .../FStar.TypeChecker.TcInductive.fst | 118 +- .../FStar.TypeChecker.TermEqAndSimplify.fst | 3 +- tests/bug-reports/BugBoxInjectivity.fst | 49 + ulib/prims.fst | 2 +- 43 files changed, 3119 insertions(+), 2727 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_CheckedFiles.ml b/ocaml/fstar-lib/generated/FStar_CheckedFiles.ml index 729e546791b..8303424e119 100644 --- a/ocaml/fstar-lib/generated/FStar_CheckedFiles.ml +++ b/ocaml/fstar-lib/generated/FStar_CheckedFiles.ml @@ -1,5 +1,5 @@ open Prims -let (cache_version_number : Prims.int) = (Prims.of_int (66)) +let (cache_version_number : Prims.int) = (Prims.of_int (67)) type tc_result = { checked_module: FStar_Syntax_Syntax.modul ; diff --git a/ocaml/fstar-lib/generated/FStar_Extraction_ML_Modul.ml b/ocaml/fstar-lib/generated/FStar_Extraction_ML_Modul.ml index 58dcb7cf5c0..fd0d46c0cfa 100644 --- a/ocaml/fstar-lib/generated/FStar_Extraction_ML_Modul.ml +++ b/ocaml/fstar-lib/generated/FStar_Extraction_ML_Modul.ml @@ -450,13 +450,14 @@ let (bundle_as_inductive_families : FStar_Syntax_Syntax.num_uniform_params = uu___1; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = uu___2; - FStar_Syntax_Syntax.ds = datas;_} + FStar_Syntax_Syntax.ds = datas; + FStar_Syntax_Syntax.injective_type_params = uu___3;_} -> - let uu___3 = FStar_Syntax_Subst.open_univ_vars us t in - (match uu___3 with + let uu___4 = FStar_Syntax_Subst.open_univ_vars us t in + (match uu___4 with | (_us, t1) -> - let uu___4 = FStar_Syntax_Subst.open_term bs t1 in - (match uu___4 with + let uu___5 = FStar_Syntax_Subst.open_term bs t1 in + (match uu___5 with | (bs1, t2) -> let datas1 = FStar_Compiler_List.collect @@ -471,93 +472,95 @@ let (bundle_as_inductive_families : FStar_Syntax_Syntax.num_ty_params = nparams; FStar_Syntax_Syntax.mutuals1 = - uu___5;_} + uu___6; + FStar_Syntax_Syntax.injective_type_params1 + = uu___7;_} when FStar_Ident.lid_equals l l' -> - let uu___6 = + let uu___8 = FStar_Syntax_Subst.open_univ_vars us1 t3 in - (match uu___6 with + (match uu___8 with | (_us1, t4) -> - let uu___7 = + let uu___9 = FStar_Syntax_Util.arrow_formals t4 in - (match uu___7 with + (match uu___9 with | (bs', body) -> - let uu___8 = + let uu___10 = FStar_Compiler_Util.first_N (FStar_Compiler_List.length bs1) bs' in - (match uu___8 with + (match uu___10 with | (bs_params, rest) -> let subst = FStar_Compiler_List.map2 - (fun uu___9 -> - fun uu___10 + (fun uu___11 -> + fun uu___12 -> match - (uu___9, - uu___10) + (uu___11, + uu___12) with | ({ FStar_Syntax_Syntax.binder_bv = b'; FStar_Syntax_Syntax.binder_qual - = uu___11; + = uu___13; FStar_Syntax_Syntax.binder_positivity - = uu___12; + = uu___14; FStar_Syntax_Syntax.binder_attrs - = uu___13;_}, + = uu___15;_}, { FStar_Syntax_Syntax.binder_bv = b; FStar_Syntax_Syntax.binder_qual - = uu___14; + = uu___16; FStar_Syntax_Syntax.binder_positivity - = uu___15; + = uu___17; FStar_Syntax_Syntax.binder_attrs - = uu___16;_}) + = uu___18;_}) -> - let uu___17 + let uu___19 = - let uu___18 + let uu___20 = FStar_Syntax_Syntax.bv_to_name b in (b', - uu___18) in + uu___20) in FStar_Syntax_Syntax.NT - uu___17) + uu___19) bs_params bs1 in let t5 = - let uu___9 = - let uu___10 = + let uu___11 = + let uu___12 = FStar_Syntax_Syntax.mk_Total body in FStar_Syntax_Util.arrow - rest uu___10 in + rest uu___12 in FStar_Syntax_Subst.subst - subst uu___9 in + subst uu___11 in [{ dname = d; dtyp = t5 }]))) - | uu___5 -> []) ses in + | uu___6 -> []) ses in let metadata = - let uu___5 = + let uu___6 = extract_metadata se.FStar_Syntax_Syntax.sigattrs in - let uu___6 = + let uu___7 = FStar_Compiler_List.choose flag_of_qual quals in - FStar_Compiler_List.op_At uu___5 uu___6 in + FStar_Compiler_List.op_At uu___6 uu___7 in let fv = FStar_Syntax_Syntax.lid_as_fv l FStar_Pervasives_Native.None in - let uu___5 = + let uu___6 = FStar_Extraction_ML_UEnv.extend_type_name env1 fv in - (match uu___5 with - | (uu___6, env2) -> + (match uu___6 with + | (uu___7, env2) -> (env2, [{ ifv = fv; @@ -1029,17 +1032,18 @@ let (extract_bundle_iface : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___1; FStar_Syntax_Syntax.num_ty_params = uu___2; - FStar_Syntax_Syntax.mutuals1 = uu___3;_}; - FStar_Syntax_Syntax.sigrng = uu___4; - FStar_Syntax_Syntax.sigquals = uu___5; - FStar_Syntax_Syntax.sigmeta = uu___6; - FStar_Syntax_Syntax.sigattrs = uu___7; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___8; - FStar_Syntax_Syntax.sigopts = uu___9;_}::[]; - FStar_Syntax_Syntax.lids = uu___10;_}, + FStar_Syntax_Syntax.mutuals1 = uu___3; + FStar_Syntax_Syntax.injective_type_params1 = uu___4;_}; + FStar_Syntax_Syntax.sigrng = uu___5; + FStar_Syntax_Syntax.sigquals = uu___6; + FStar_Syntax_Syntax.sigmeta = uu___7; + FStar_Syntax_Syntax.sigattrs = uu___8; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; + FStar_Syntax_Syntax.sigopts = uu___10;_}::[]; + FStar_Syntax_Syntax.lids = uu___11;_}, (FStar_Syntax_Syntax.ExceptionConstructor)::[]) -> - let uu___11 = extract_ctor env [] env { dname = l; dtyp = t } in - (match uu___11 with + let uu___12 = extract_ctor env [] env { dname = l; dtyp = t } in + (match uu___12 with | (env1, ctor) -> (env1, (iface_of_bindings [ctor]))) | (FStar_Syntax_Syntax.Sig_bundle { FStar_Syntax_Syntax.ses = ses; FStar_Syntax_Syntax.lids = uu___;_}, @@ -2070,17 +2074,18 @@ let (extract_bundle : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___1; FStar_Syntax_Syntax.num_ty_params = uu___2; - FStar_Syntax_Syntax.mutuals1 = uu___3;_}; - FStar_Syntax_Syntax.sigrng = uu___4; - FStar_Syntax_Syntax.sigquals = uu___5; - FStar_Syntax_Syntax.sigmeta = uu___6; - FStar_Syntax_Syntax.sigattrs = uu___7; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___8; - FStar_Syntax_Syntax.sigopts = uu___9;_}::[]; - FStar_Syntax_Syntax.lids = uu___10;_}, + FStar_Syntax_Syntax.mutuals1 = uu___3; + FStar_Syntax_Syntax.injective_type_params1 = uu___4;_}; + FStar_Syntax_Syntax.sigrng = uu___5; + FStar_Syntax_Syntax.sigquals = uu___6; + FStar_Syntax_Syntax.sigmeta = uu___7; + FStar_Syntax_Syntax.sigattrs = uu___8; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; + FStar_Syntax_Syntax.sigopts = uu___10;_}::[]; + FStar_Syntax_Syntax.lids = uu___11;_}, (FStar_Syntax_Syntax.ExceptionConstructor)::[]) -> - let uu___11 = extract_ctor env [] env { dname = l; dtyp = t } in - (match uu___11 with + let uu___12 = extract_ctor env [] env { dname = l; dtyp = t } in + (match uu___12 with | (env1, ctor) -> (env1, [FStar_Extraction_ML_Syntax.mk_mlmodule1_with_attrs diff --git a/ocaml/fstar-lib/generated/FStar_Extraction_ML_RegEmb.ml b/ocaml/fstar-lib/generated/FStar_Extraction_ML_RegEmb.ml index aac544dad71..acc7688f8a3 100644 --- a/ocaml/fstar-lib/generated/FStar_Extraction_ML_RegEmb.ml +++ b/ocaml/fstar-lib/generated/FStar_Extraction_ML_RegEmb.ml @@ -1688,72 +1688,73 @@ let (mk_unembed : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = ty_lid; FStar_Syntax_Syntax.num_ty_params = num_ty_params; - FStar_Syntax_Syntax.mutuals1 = uu___1;_} + FStar_Syntax_Syntax.mutuals1 = uu___1; + FStar_Syntax_Syntax.injective_type_params1 = uu___2;_} -> let fv = fresh "fv" in - let uu___2 = FStar_Syntax_Util.arrow_formals t in - (match uu___2 with + let uu___3 = FStar_Syntax_Util.arrow_formals t in + (match uu___3 with | (bs, c) -> let vs = FStar_Compiler_List.map (fun b -> - let uu___3 = - let uu___4 = + let uu___4 = + let uu___5 = FStar_Ident.string_of_id (b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.ppname in - fresh uu___4 in - (uu___3, + fresh uu___5 in + (uu___4, ((b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort))) bs in let pat_s = - let uu___3 = - let uu___4 = FStar_Ident.string_of_lid lid in - FStar_Extraction_ML_Syntax.MLC_String uu___4 in - FStar_Extraction_ML_Syntax.MLP_Const uu___3 in + let uu___4 = + let uu___5 = FStar_Ident.string_of_lid lid in + FStar_Extraction_ML_Syntax.MLC_String uu___5 in + FStar_Extraction_ML_Syntax.MLP_Const uu___4 in let pat_args = - let uu___3 = + let uu___4 = FStar_Compiler_List.map - (fun uu___4 -> - match uu___4 with - | (v, uu___5) -> + (fun uu___5 -> + match uu___5 with + | (v, uu___6) -> FStar_Extraction_ML_Syntax.MLP_Var v) vs in - pats_to_list_pat uu___3 in + pats_to_list_pat uu___4 in let pat_both = FStar_Extraction_ML_Syntax.MLP_Tuple [pat_s; pat_args] in let ret = match record_fields with | FStar_Pervasives_Native.Some fields -> - let uu___3 = + let uu___4 = FStar_Compiler_List.map2 - (fun uu___4 -> + (fun uu___5 -> fun fld -> - match uu___4 with - | (v, uu___5) -> + match uu___5 with + | (v, uu___6) -> ((FStar_Pervasives_Native.snd fld), (mk (FStar_Extraction_ML_Syntax.MLE_Var v)))) vs fields in - ml_record lid uu___3 + ml_record lid uu___4 | FStar_Pervasives_Native.None -> - let uu___3 = + let uu___4 = FStar_Compiler_List.map - (fun uu___4 -> - match uu___4 with - | (v, uu___5) -> + (fun uu___5 -> + match uu___5 with + | (v, uu___6) -> mk (FStar_Extraction_ML_Syntax.MLE_Var v)) vs in - ml_ctor lid uu___3 in + ml_ctor lid uu___4 in let ret1 = mk (FStar_Extraction_ML_Syntax.MLE_App (ml_some, [ret])) in let body = FStar_Compiler_List.fold_right - (fun uu___3 -> + (fun uu___4 -> fun body1 -> - match uu___3 with + match uu___4 with | (v, ty) -> let body2 = mk @@ -1761,41 +1762,41 @@ let (mk_unembed : ([mk_binder v FStar_Extraction_ML_Syntax.MLTY_Top], body1)) in - let uu___4 = - let uu___5 = - let uu___6 = ml_name bind_opt_lid in - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = - let uu___11 = - ml_name unembed_lid in + let uu___5 = + let uu___6 = + let uu___7 = ml_name bind_opt_lid in + let uu___8 = + let uu___9 = + let uu___10 = + let uu___11 = let uu___12 = - let uu___13 = + ml_name unembed_lid in + let uu___13 = + let uu___14 = embedding_for tcenv mutuals SyntaxTerm [] ty in - [uu___13; + [uu___14; mk (FStar_Extraction_ML_Syntax.MLE_Var v)] in - (uu___11, uu___12) in + (uu___12, uu___13) in FStar_Extraction_ML_Syntax.MLE_App - uu___10 in - mk uu___9 in - [uu___8; body2] in - (uu___6, uu___7) in + uu___11 in + mk uu___10 in + [uu___9; body2] in + (uu___7, uu___8) in FStar_Extraction_ML_Syntax.MLE_App - uu___5 in - mk uu___4) vs ret1 in + uu___6 in + mk uu___5) vs ret1 in let br = (pat_both, FStar_Pervasives_Native.None, body) in - let uu___3 = - let uu___4 = + let uu___4 = + let uu___5 = FStar_Compiler_Effect.op_Bang e_branches in - br :: uu___4 in + br :: uu___5 in FStar_Compiler_Effect.op_Colon_Equals e_branches - uu___3) + uu___4) | uu___1 -> FStar_Compiler_Effect.failwith "impossible, filter above") ctors; @@ -1838,28 +1839,29 @@ let (mk_embed : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = ty_lid; FStar_Syntax_Syntax.num_ty_params = num_ty_params; - FStar_Syntax_Syntax.mutuals1 = uu___1;_} + FStar_Syntax_Syntax.mutuals1 = uu___1; + FStar_Syntax_Syntax.injective_type_params1 = uu___2;_} -> let fv = fresh "fv" in - let uu___2 = FStar_Syntax_Util.arrow_formals t in - (match uu___2 with + let uu___3 = FStar_Syntax_Util.arrow_formals t in + (match uu___3 with | (bs, c) -> let vs = FStar_Compiler_List.map (fun b -> - let uu___3 = - let uu___4 = + let uu___4 = + let uu___5 = FStar_Ident.string_of_id (b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.ppname in - fresh uu___4 in - (uu___3, + fresh uu___5 in + (uu___4, ((b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort))) bs in let pat = match record_fields with | FStar_Pervasives_Native.Some fields -> - let uu___3 = - let uu___4 = + let uu___4 = + let uu___5 = FStar_Compiler_List.map2 (fun v -> fun fld -> @@ -1867,48 +1869,48 @@ let (mk_embed : (FStar_Extraction_ML_Syntax.MLP_Var (FStar_Pervasives_Native.fst v)))) vs fields in - ([], uu___4) in - FStar_Extraction_ML_Syntax.MLP_Record uu___3 + ([], uu___5) in + FStar_Extraction_ML_Syntax.MLP_Record uu___4 | FStar_Pervasives_Native.None -> - let uu___3 = - let uu___4 = - let uu___5 = FStar_Ident.path_of_lid lid in - splitlast uu___5 in + let uu___4 = let uu___5 = + let uu___6 = FStar_Ident.path_of_lid lid in + splitlast uu___6 in + let uu___6 = FStar_Compiler_List.map (fun v -> FStar_Extraction_ML_Syntax.MLP_Var (FStar_Pervasives_Native.fst v)) vs in - (uu___4, uu___5) in - FStar_Extraction_ML_Syntax.MLP_CTor uu___3 in + (uu___5, uu___6) in + FStar_Extraction_ML_Syntax.MLP_CTor uu___4 in let fvar = ml_name s_tdataconstr_lid in let lid_of_str = ml_name lid_of_str_lid in let head = - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = - let uu___11 = - let uu___12 = - let uu___13 = + let uu___4 = + let uu___5 = + let uu___6 = + let uu___7 = + let uu___8 = + let uu___9 = + let uu___10 = + let uu___11 = + let uu___12 = + let uu___13 = + let uu___14 = FStar_Ident.string_of_lid lid in FStar_Extraction_ML_Syntax.MLC_String - uu___13 in + uu___14 in FStar_Extraction_ML_Syntax.MLE_Const - uu___12 in - mk uu___11 in - [uu___10] in - (lid_of_str, uu___9) in - FStar_Extraction_ML_Syntax.MLE_App uu___8 in - mk uu___7 in - [uu___6] in - (fvar, uu___5) in - FStar_Extraction_ML_Syntax.MLE_App uu___4 in - mk uu___3 in + uu___13 in + mk uu___12 in + [uu___11] in + (lid_of_str, uu___10) in + FStar_Extraction_ML_Syntax.MLE_App uu___9 in + mk uu___8 in + [uu___7] in + (fvar, uu___6) in + FStar_Extraction_ML_Syntax.MLE_App uu___5 in + mk uu___4 in let mk_mk_app t1 ts = let ts1 = FStar_Compiler_List.map @@ -1916,44 +1918,44 @@ let (mk_embed : mk (FStar_Extraction_ML_Syntax.MLE_Tuple [t2; ml_none])) ts in - let uu___3 = - let uu___4 = - let uu___5 = ml_name mk_app_lid in - let uu___6 = - let uu___7 = - let uu___8 = as_ml_list ts1 in [uu___8] in - t1 :: uu___7 in - (uu___5, uu___6) in - FStar_Extraction_ML_Syntax.MLE_App uu___4 in - mk uu___3 in + let uu___4 = + let uu___5 = + let uu___6 = ml_name mk_app_lid in + let uu___7 = + let uu___8 = + let uu___9 = as_ml_list ts1 in [uu___9] in + t1 :: uu___8 in + (uu___6, uu___7) in + FStar_Extraction_ML_Syntax.MLE_App uu___5 in + mk uu___4 in let args = FStar_Compiler_List.map - (fun uu___3 -> - match uu___3 with + (fun uu___4 -> + match uu___4 with | (v, ty) -> let vt = mk (FStar_Extraction_ML_Syntax.MLE_Var v) in - let uu___4 = - let uu___5 = - let uu___6 = ml_name embed_lid in - let uu___7 = - let uu___8 = + let uu___5 = + let uu___6 = + let uu___7 = ml_name embed_lid in + let uu___8 = + let uu___9 = embedding_for tcenv mutuals SyntaxTerm [] ty in - [uu___8; vt] in - (uu___6, uu___7) in + [uu___9; vt] in + (uu___7, uu___8) in FStar_Extraction_ML_Syntax.MLE_App - uu___5 in - mk uu___4) vs in + uu___6 in + mk uu___5) vs in let ret = mk_mk_app head args in let br = (pat, FStar_Pervasives_Native.None, ret) in - let uu___3 = - let uu___4 = + let uu___4 = + let uu___5 = FStar_Compiler_Effect.op_Bang e_branches in - br :: uu___4 in + br :: uu___5 in FStar_Compiler_Effect.op_Colon_Equals e_branches - uu___3) + uu___4) | uu___1 -> FStar_Compiler_Effect.failwith "impossible, filter above") ctors; @@ -2051,7 +2053,8 @@ let (__do_handle_plugin : FStar_Syntax_Syntax.num_uniform_params = uu___3; FStar_Syntax_Syntax.t = uu___4; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_} + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_} -> lid) mutual_sigelts in let proc_one typ_sigelt = let uu___1 = typ_sigelt.FStar_Syntax_Syntax.sigel in @@ -2063,7 +2066,8 @@ let (__do_handle_plugin : FStar_Syntax_Syntax.num_uniform_params = uu___3; FStar_Syntax_Syntax.t = uu___4; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_} + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_} -> (if (FStar_Compiler_List.length ps) > Prims.int_zero then @@ -2072,48 +2076,50 @@ let (__do_handle_plugin : else (); (let ns = FStar_Ident.ns_of_lid tlid in let name = - let uu___8 = - let uu___9 = FStar_Ident.ids_of_lid tlid in - FStar_Compiler_List.last uu___9 in - FStar_Ident.string_of_id uu___8 in + let uu___9 = + let uu___10 = FStar_Ident.ids_of_lid tlid in + FStar_Compiler_List.last uu___10 in + FStar_Ident.string_of_id uu___9 in let ctors = FStar_Compiler_List.filter (fun se1 -> match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_datacon - { FStar_Syntax_Syntax.lid1 = uu___8; - FStar_Syntax_Syntax.us1 = uu___9; - FStar_Syntax_Syntax.t1 = uu___10; + { FStar_Syntax_Syntax.lid1 = uu___9; + FStar_Syntax_Syntax.us1 = uu___10; + FStar_Syntax_Syntax.t1 = uu___11; FStar_Syntax_Syntax.ty_lid = ty_lid; - FStar_Syntax_Syntax.num_ty_params = uu___11; - FStar_Syntax_Syntax.mutuals1 = uu___12;_} + FStar_Syntax_Syntax.num_ty_params = uu___12; + FStar_Syntax_Syntax.mutuals1 = uu___13; + FStar_Syntax_Syntax.injective_type_params1 = + uu___14;_} -> FStar_Ident.lid_equals ty_lid tlid - | uu___8 -> false) ses in + | uu___9 -> false) ses in let ml_name1 = - let uu___8 = - let uu___9 = - let uu___10 = FStar_Ident.string_of_lid tlid in - FStar_Extraction_ML_Syntax.MLC_String uu___10 in - FStar_Extraction_ML_Syntax.MLE_Const uu___9 in - mk uu___8 in + let uu___9 = + let uu___10 = + let uu___11 = FStar_Ident.string_of_lid tlid in + FStar_Extraction_ML_Syntax.MLC_String uu___11 in + FStar_Extraction_ML_Syntax.MLE_Const uu___10 in + mk uu___9 in let record_fields = - let uu___8 = + let uu___9 = FStar_Compiler_List.find - (fun uu___9 -> - match uu___9 with - | FStar_Syntax_Syntax.RecordType uu___10 -> true - | uu___10 -> false) + (fun uu___10 -> + match uu___10 with + | FStar_Syntax_Syntax.RecordType uu___11 -> true + | uu___11 -> false) typ_sigelt.FStar_Syntax_Syntax.sigquals in - match uu___8 with + match uu___9 with | FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.RecordType (uu___9, b)) -> - let uu___10 = + (FStar_Syntax_Syntax.RecordType (uu___10, b)) -> + let uu___11 = FStar_Compiler_List.map (fun f -> FStar_Extraction_ML_UEnv.lookup_record_field_name g (tlid, f)) b in - FStar_Pervasives_Native.Some uu___10 - | uu___9 -> FStar_Pervasives_Native.None in + FStar_Pervasives_Native.Some uu___11 + | uu___10 -> FStar_Pervasives_Native.None in let tcenv = FStar_Extraction_ML_UEnv.tcenv_of_uenv g in let ml_unembed = mk_unembed tcenv mutual_lids record_fields ctors in @@ -2144,19 +2150,19 @@ let (__do_handle_plugin : FStar_Extraction_ML_Syntax.mllb_meta = []; FStar_Extraction_ML_Syntax.print_typ = false } in - (let uu___9 = - let uu___10 = - let uu___11 = + (let uu___10 = + let uu___11 = + let uu___12 = FStar_Ident.mk_ident ((Prims.strcat "e_" name), FStar_Compiler_Range_Type.dummyRange) in - FStar_Ident.lid_of_ns_and_id ns uu___11 in + FStar_Ident.lid_of_ns_and_id ns uu___12 in { arity = Prims.int_zero; - syn_emb = uu___10; + syn_emb = uu___11; nbe_emb = FStar_Pervasives_Native.None } in - register_embedding tlid uu___9); + register_embedding tlid uu___10); [lb])) in let lbs = FStar_Compiler_List.concatMap proc_one mutual_sigelts in let unthunking = @@ -2171,7 +2177,8 @@ let (__do_handle_plugin : FStar_Syntax_Syntax.num_uniform_params = uu___3; FStar_Syntax_Syntax.t = uu___4; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_} + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_} -> tlid1 in let name = let uu___1 = diff --git a/ocaml/fstar-lib/generated/FStar_Reflection_V1_Builtins.ml b/ocaml/fstar-lib/generated/FStar_Reflection_V1_Builtins.ml index 8679a07295b..1d431cf3cd4 100644 --- a/ocaml/fstar-lib/generated/FStar_Reflection_V1_Builtins.ml +++ b/ocaml/fstar-lib/generated/FStar_Reflection_V1_Builtins.ml @@ -882,22 +882,23 @@ let (inspect_sigelt : FStar_Syntax_Syntax.params = param_bs; FStar_Syntax_Syntax.num_uniform_params = uu___; FStar_Syntax_Syntax.t = ty; FStar_Syntax_Syntax.mutuals = uu___1; - FStar_Syntax_Syntax.ds = c_lids;_} + FStar_Syntax_Syntax.ds = c_lids; + FStar_Syntax_Syntax.injective_type_params = uu___2;_} -> let nm = FStar_Ident.path_of_lid lid in - let uu___2 = FStar_Syntax_Subst.univ_var_opening us in - (match uu___2 with + let uu___3 = FStar_Syntax_Subst.univ_var_opening us in + (match uu___3 with | (s, us1) -> let param_bs1 = FStar_Syntax_Subst.subst_binders s param_bs in let ty1 = FStar_Syntax_Subst.subst s ty in - let uu___3 = FStar_Syntax_Subst.open_term param_bs1 ty1 in - (match uu___3 with + let uu___4 = FStar_Syntax_Subst.open_term param_bs1 ty1 in + (match uu___4 with | (param_bs2, ty2) -> let inspect_ctor c_lid = - let uu___4 = - let uu___5 = get_env () in - FStar_TypeChecker_Env.lookup_sigelt uu___5 c_lid in - match uu___4 with + let uu___5 = + let uu___6 = get_env () in + FStar_TypeChecker_Env.lookup_sigelt uu___6 c_lid in + match uu___5 with | FStar_Pervasives_Native.Some { FStar_Syntax_Syntax.sigel = @@ -905,22 +906,24 @@ let (inspect_sigelt : { FStar_Syntax_Syntax.lid1 = lid1; FStar_Syntax_Syntax.us1 = us2; FStar_Syntax_Syntax.t1 = cty; - FStar_Syntax_Syntax.ty_lid = uu___5; + FStar_Syntax_Syntax.ty_lid = uu___6; FStar_Syntax_Syntax.num_ty_params = nparam; - FStar_Syntax_Syntax.mutuals1 = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_} + FStar_Syntax_Syntax.mutuals1 = uu___7; + FStar_Syntax_Syntax.injective_type_params1 = + uu___8;_}; + FStar_Syntax_Syntax.sigrng = uu___9; + FStar_Syntax_Syntax.sigquals = uu___10; + FStar_Syntax_Syntax.sigmeta = uu___11; + FStar_Syntax_Syntax.sigattrs = uu___12; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___13; + FStar_Syntax_Syntax.sigopts = uu___14;_} -> let cty1 = FStar_Syntax_Subst.subst s cty in - let uu___13 = - let uu___14 = get_env () in - FStar_TypeChecker_Normalize.get_n_binders uu___14 + let uu___15 = + let uu___16 = get_env () in + FStar_TypeChecker_Normalize.get_n_binders uu___16 nparam cty1 in - (match uu___13 with + (match uu___15 with | (param_ctor_bs, c) -> (if (FStar_Compiler_List.length param_ctor_bs) <> @@ -929,11 +932,11 @@ let (inspect_sigelt : FStar_Compiler_Effect.failwith "impossible: inspect_sigelt: could not obtain sufficient ctor param binders" else (); - (let uu___16 = - let uu___17 = + (let uu___18 = + let uu___19 = FStar_Syntax_Util.is_total_comp c in - Prims.op_Negation uu___17 in - if uu___16 + Prims.op_Negation uu___19 in + if uu___18 then FStar_Compiler_Effect.failwith "impossible: inspect_sigelt: removed parameters and got an effectful comp" @@ -943,26 +946,26 @@ let (inspect_sigelt : FStar_Compiler_List.map2 (fun b1 -> fun b2 -> - let uu___16 = - let uu___17 = + let uu___18 = + let uu___19 = FStar_Syntax_Syntax.bv_to_name b2.FStar_Syntax_Syntax.binder_bv in ((b1.FStar_Syntax_Syntax.binder_bv), - uu___17) in - FStar_Syntax_Syntax.NT uu___16) + uu___19) in + FStar_Syntax_Syntax.NT uu___18) param_ctor_bs param_bs2 in let cty3 = FStar_Syntax_Subst.subst s' cty2 in let cty4 = FStar_Syntax_Util.remove_inacc cty3 in - let uu___16 = FStar_Ident.path_of_lid lid1 in - (uu___16, cty4)))) - | uu___5 -> + let uu___18 = FStar_Ident.path_of_lid lid1 in + (uu___18, cty4)))) + | uu___6 -> FStar_Compiler_Effect.failwith "impossible: inspect_sigelt: did not find ctor" in - let uu___4 = - let uu___5 = FStar_Compiler_List.map inspect_ident us1 in - let uu___6 = FStar_Compiler_List.map inspect_ctor c_lids in - (nm, uu___5, param_bs2, ty2, uu___6) in - FStar_Reflection_V1_Data.Sg_Inductive uu___4)) + let uu___5 = + let uu___6 = FStar_Compiler_List.map inspect_ident us1 in + let uu___7 = FStar_Compiler_List.map inspect_ctor c_lids in + (nm, uu___6, param_bs2, ty2, uu___7) in + FStar_Reflection_V1_Data.Sg_Inductive uu___5)) | FStar_Syntax_Syntax.Sig_declare_typ { FStar_Syntax_Syntax.lid2 = lid; FStar_Syntax_Syntax.us2 = us; FStar_Syntax_Syntax.t2 = ty;_} @@ -1037,6 +1040,7 @@ let (pack_sigelt : (check_lid ind_lid; (let s = FStar_Syntax_Subst.univ_var_closing us_names1 in let nparam = FStar_Compiler_List.length param_bs in + let injective_type_params = false in let pack_ctor c = let uu___1 = c in match uu___1 with @@ -1056,7 +1060,9 @@ let (pack_sigelt : FStar_Syntax_Syntax.t1 = ty3; FStar_Syntax_Syntax.ty_lid = ind_lid; FStar_Syntax_Syntax.num_ty_params = nparam; - FStar_Syntax_Syntax.mutuals1 = [] + FStar_Syntax_Syntax.mutuals1 = []; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params }) in let ctor_ses = FStar_Compiler_List.map pack_ctor ctors in let c_lids = @@ -1079,7 +1085,9 @@ let (pack_sigelt : FStar_Pervasives_Native.None; FStar_Syntax_Syntax.t = ty2; FStar_Syntax_Syntax.mutuals = []; - FStar_Syntax_Syntax.ds = c_lids + FStar_Syntax_Syntax.ds = c_lids; + FStar_Syntax_Syntax.injective_type_params = + injective_type_params }) in let se = FStar_Syntax_Syntax.mk_sigelt diff --git a/ocaml/fstar-lib/generated/FStar_Reflection_V2_Builtins.ml b/ocaml/fstar-lib/generated/FStar_Reflection_V2_Builtins.ml index 3c6ea77ae05..245ff6c1fe4 100644 --- a/ocaml/fstar-lib/generated/FStar_Reflection_V2_Builtins.ml +++ b/ocaml/fstar-lib/generated/FStar_Reflection_V2_Builtins.ml @@ -834,37 +834,39 @@ let (inspect_sigelt : FStar_Syntax_Syntax.params = param_bs; FStar_Syntax_Syntax.num_uniform_params = uu___; FStar_Syntax_Syntax.t = ty; FStar_Syntax_Syntax.mutuals = uu___1; - FStar_Syntax_Syntax.ds = c_lids;_} + FStar_Syntax_Syntax.ds = c_lids; + FStar_Syntax_Syntax.injective_type_params = uu___2;_} -> let nm = FStar_Ident.path_of_lid lid in let inspect_ctor c_lid = - let uu___2 = - let uu___3 = get_env () in - FStar_TypeChecker_Env.lookup_sigelt uu___3 c_lid in - match uu___2 with + let uu___3 = + let uu___4 = get_env () in + FStar_TypeChecker_Env.lookup_sigelt uu___4 c_lid in + match uu___3 with | FStar_Pervasives_Native.Some { FStar_Syntax_Syntax.sigel = FStar_Syntax_Syntax.Sig_datacon { FStar_Syntax_Syntax.lid1 = lid1; FStar_Syntax_Syntax.us1 = us1; FStar_Syntax_Syntax.t1 = cty; - FStar_Syntax_Syntax.ty_lid = uu___3; + FStar_Syntax_Syntax.ty_lid = uu___4; FStar_Syntax_Syntax.num_ty_params = nparam; - FStar_Syntax_Syntax.mutuals1 = uu___4;_}; - FStar_Syntax_Syntax.sigrng = uu___5; - FStar_Syntax_Syntax.sigquals = uu___6; - FStar_Syntax_Syntax.sigmeta = uu___7; - FStar_Syntax_Syntax.sigattrs = uu___8; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; - FStar_Syntax_Syntax.sigopts = uu___10;_} - -> let uu___11 = FStar_Ident.path_of_lid lid1 in (uu___11, cty) - | uu___3 -> + FStar_Syntax_Syntax.mutuals1 = uu___5; + FStar_Syntax_Syntax.injective_type_params1 = uu___6;_}; + FStar_Syntax_Syntax.sigrng = uu___7; + FStar_Syntax_Syntax.sigquals = uu___8; + FStar_Syntax_Syntax.sigmeta = uu___9; + FStar_Syntax_Syntax.sigattrs = uu___10; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; + FStar_Syntax_Syntax.sigopts = uu___12;_} + -> let uu___13 = FStar_Ident.path_of_lid lid1 in (uu___13, cty) + | uu___4 -> FStar_Compiler_Effect.failwith "impossible: inspect_sigelt: did not find ctor" in - let uu___2 = - let uu___3 = FStar_Compiler_List.map inspect_ctor c_lids in - (nm, us, param_bs, ty, uu___3) in - FStar_Reflection_V2_Data.Sg_Inductive uu___2 + let uu___3 = + let uu___4 = FStar_Compiler_List.map inspect_ctor c_lids in + (nm, us, param_bs, ty, uu___4) in + FStar_Reflection_V2_Data.Sg_Inductive uu___3 | FStar_Syntax_Syntax.Sig_declare_typ { FStar_Syntax_Syntax.lid2 = lid; FStar_Syntax_Syntax.us2 = us; FStar_Syntax_Syntax.t2 = ty;_} @@ -924,6 +926,7 @@ let (pack_sigelt : FStar_Ident.lid_of_path nm FStar_Compiler_Range_Type.dummyRange in (check_lid ind_lid; (let nparam = FStar_Compiler_List.length param_bs in + let injective_type_params = false in let pack_ctor c = let uu___1 = c in match uu___1 with @@ -939,7 +942,9 @@ let (pack_sigelt : FStar_Syntax_Syntax.t1 = ty1; FStar_Syntax_Syntax.ty_lid = ind_lid; FStar_Syntax_Syntax.num_ty_params = nparam; - FStar_Syntax_Syntax.mutuals1 = [] + FStar_Syntax_Syntax.mutuals1 = []; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params }) in let ctor_ses = FStar_Compiler_List.map pack_ctor ctors in let c_lids = @@ -958,7 +963,9 @@ let (pack_sigelt : FStar_Pervasives_Native.None; FStar_Syntax_Syntax.t = ty; FStar_Syntax_Syntax.mutuals = []; - FStar_Syntax_Syntax.ds = c_lids + FStar_Syntax_Syntax.ds = c_lids; + FStar_Syntax_Syntax.injective_type_params = + injective_type_params }) in let se = FStar_Syntax_Syntax.mk_sigelt diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index bd30c5cf7e8..ffebb10d50e 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -3782,8 +3782,11 @@ let (encode_top_level_let : (Prims.strcat "let rec unencodeable: Skipping: " msg) in let uu___2 = FStar_SMTEncoding_Term.mk_decls_trivial [decl] in (uu___2, env)) -let (is_sig_inductive_injective_on_params : - FStar_SMTEncoding_Env.env_t -> FStar_Syntax_Syntax.sigelt -> Prims.bool) = +let (encode_sig_inductive : + FStar_SMTEncoding_Env.env_t -> + FStar_Syntax_Syntax.sigelt -> + (FStar_SMTEncoding_Term.decls_t * FStar_SMTEncoding_Env.env_t)) + = fun env -> fun se -> let uu___ = se.FStar_Syntax_Syntax.sigel in @@ -3794,888 +3797,656 @@ let (is_sig_inductive_injective_on_params : FStar_Syntax_Syntax.params = tps; FStar_Syntax_Syntax.num_uniform_params = uu___1; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___2; - FStar_Syntax_Syntax.ds = uu___3;_} + FStar_Syntax_Syntax.ds = datas; + FStar_Syntax_Syntax.injective_type_params = injective_type_params;_} -> let t_lid = t in let tcenv = env.FStar_SMTEncoding_Env.tcenv in - let uu___4 = FStar_Syntax_Subst.univ_var_opening universe_names in - (match uu___4 with - | (usubst, uvs) -> - let uu___5 = - let uu___6 = FStar_TypeChecker_Env.push_univ_vars tcenv uvs in - let uu___7 = FStar_Syntax_Subst.subst_binders usubst tps in - let uu___8 = - let uu___9 = - FStar_Syntax_Subst.shift_subst - (FStar_Compiler_List.length tps) usubst in - FStar_Syntax_Subst.subst uu___9 k in - (uu___6, uu___7, uu___8) in - (match uu___5 with - | (tcenv1, tps1, k1) -> - let uu___6 = FStar_Syntax_Subst.open_term tps1 k1 in - (match uu___6 with - | (tps2, k2) -> - let uu___7 = FStar_Syntax_Util.arrow_formals k2 in - (match uu___7 with - | (uu___8, k3) -> - let uu___9 = - FStar_TypeChecker_TcTerm.tc_binders tcenv1 - tps2 in - (match uu___9 with - | (tps3, env_tps, uu___10, us) -> - let u_k = - let uu___11 = - let uu___12 = - FStar_Syntax_Syntax.fvar t - FStar_Pervasives_Native.None in - let uu___13 = - let uu___14 = - FStar_Syntax_Util.args_of_binders - tps3 in - FStar_Pervasives_Native.snd uu___14 in - let uu___14 = - FStar_Ident.range_of_lid t in - FStar_Syntax_Syntax.mk_Tm_app uu___12 - uu___13 uu___14 in - FStar_TypeChecker_TcTerm.level_of_type - env_tps uu___11 k3 in - let rec universe_leq u v = - match (u, v) with - | (FStar_Syntax_Syntax.U_zero, uu___11) - -> true - | (FStar_Syntax_Syntax.U_succ u0, - FStar_Syntax_Syntax.U_succ v0) -> - universe_leq u0 v0 - | (FStar_Syntax_Syntax.U_name u0, - FStar_Syntax_Syntax.U_name v0) -> - FStar_Ident.ident_equals u0 v0 - | (FStar_Syntax_Syntax.U_name uu___11, - FStar_Syntax_Syntax.U_succ v0) -> - universe_leq u v0 - | (FStar_Syntax_Syntax.U_max us1, - uu___11) -> - FStar_Compiler_Util.for_all - (fun u1 -> universe_leq u1 v) us1 - | (uu___11, FStar_Syntax_Syntax.U_max - vs) -> - FStar_Compiler_Util.for_some - (universe_leq u) vs - | (FStar_Syntax_Syntax.U_unknown, - uu___11) -> - let uu___12 = - let uu___13 = - FStar_Ident.string_of_lid t in - let uu___14 = - FStar_Syntax_Print.univ_to_string - u in - let uu___15 = - FStar_Syntax_Print.univ_to_string - v in - FStar_Compiler_Util.format3 - "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - uu___13 uu___14 uu___15 in - FStar_Compiler_Effect.failwith - uu___12 - | (uu___11, - FStar_Syntax_Syntax.U_unknown) -> - let uu___12 = - let uu___13 = - FStar_Ident.string_of_lid t in - let uu___14 = - FStar_Syntax_Print.univ_to_string - u in - let uu___15 = - FStar_Syntax_Print.univ_to_string - v in - FStar_Compiler_Util.format3 - "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - uu___13 uu___14 uu___15 in - FStar_Compiler_Effect.failwith - uu___12 - | (FStar_Syntax_Syntax.U_unif uu___11, - uu___12) -> - let uu___13 = - let uu___14 = - FStar_Ident.string_of_lid t in - let uu___15 = - FStar_Syntax_Print.univ_to_string - u in - let uu___16 = - FStar_Syntax_Print.univ_to_string - v in - FStar_Compiler_Util.format3 - "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - uu___14 uu___15 uu___16 in - FStar_Compiler_Effect.failwith - uu___13 - | (uu___11, FStar_Syntax_Syntax.U_unif - uu___12) -> - let uu___13 = - let uu___14 = - FStar_Ident.string_of_lid t in - let uu___15 = - FStar_Syntax_Print.univ_to_string - u in - let uu___16 = - FStar_Syntax_Print.univ_to_string - v in - FStar_Compiler_Util.format3 - "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - uu___14 uu___15 uu___16 in - FStar_Compiler_Effect.failwith - uu___13 - | uu___11 -> false in - let u_leq_u_k u = - let u1 = - FStar_TypeChecker_Normalize.normalize_universe - env_tps u in - universe_leq u1 u_k in - let tp_ok tp u_tp = - let t_tp = - (tp.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in - let uu___11 = u_leq_u_k u_tp in - if uu___11 - then true - else - (let t_tp1 = - FStar_TypeChecker_Normalize.normalize - [FStar_TypeChecker_Env.Unrefine; - FStar_TypeChecker_Env.Unascribe; - FStar_TypeChecker_Env.Unmeta; - FStar_TypeChecker_Env.Primops; - FStar_TypeChecker_Env.HNF; - FStar_TypeChecker_Env.UnfoldUntil - FStar_Syntax_Syntax.delta_constant; - FStar_TypeChecker_Env.Beta] - env_tps t_tp in - let uu___13 = - FStar_Syntax_Util.arrow_formals - t_tp1 in - match uu___13 with - | (formals, t1) -> - let uu___14 = - FStar_TypeChecker_TcTerm.tc_binders - env_tps formals in - (match uu___14 with - | (uu___15, uu___16, uu___17, - u_formals) -> - let inj = - FStar_Compiler_Util.for_all - (fun u_formal -> - u_leq_u_k u_formal) - u_formals in - if inj - then - let uu___18 = - let uu___19 = - FStar_Syntax_Subst.compress - t1 in - uu___19.FStar_Syntax_Syntax.n in - (match uu___18 with - | FStar_Syntax_Syntax.Tm_type - u -> u_leq_u_k u - | uu___19 -> false) - else false)) in - let is_injective_on_params = - FStar_Compiler_List.forall2 tp_ok tps3 - us in - ((let uu___12 = - FStar_TypeChecker_Env.debug - env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in - if uu___12 - then - let uu___13 = - FStar_Ident.string_of_lid t in - FStar_Compiler_Util.print2 - "%s injectivity for %s\n" - (if is_injective_on_params - then "YES" - else "NO") uu___13 - else ()); - is_injective_on_params)))))) -let (encode_sig_inductive : - Prims.bool -> - FStar_SMTEncoding_Env.env_t -> - FStar_Syntax_Syntax.sigelt -> - (FStar_SMTEncoding_Term.decls_t * FStar_SMTEncoding_Env.env_t)) - = - fun is_injective_on_params -> - fun env -> - fun se -> - let uu___ = se.FStar_Syntax_Syntax.sigel in - match uu___ with - | FStar_Syntax_Syntax.Sig_inductive_typ - { FStar_Syntax_Syntax.lid = t; - FStar_Syntax_Syntax.us = universe_names; - FStar_Syntax_Syntax.params = tps; - FStar_Syntax_Syntax.num_uniform_params = uu___1; - FStar_Syntax_Syntax.t = k; - FStar_Syntax_Syntax.mutuals = uu___2; - FStar_Syntax_Syntax.ds = datas;_} - -> - let t_lid = t in - let tcenv = env.FStar_SMTEncoding_Env.tcenv in - let quals = se.FStar_Syntax_Syntax.sigquals in - let is_logical = - FStar_Compiler_Util.for_some - (fun uu___3 -> - match uu___3 with - | FStar_Syntax_Syntax.Logic -> true - | FStar_Syntax_Syntax.Assumption -> true - | uu___4 -> false) quals in - let constructor_or_logic_type_decl c = - if is_logical - then - let uu___3 = - let uu___4 = - let uu___5 = - FStar_Compiler_List.map - (fun f -> f.FStar_SMTEncoding_Term.field_sort) - c.FStar_SMTEncoding_Term.constr_fields in - ((c.FStar_SMTEncoding_Term.constr_name), uu___5, - FStar_SMTEncoding_Term.Term_sort, - FStar_Pervasives_Native.None) in - FStar_SMTEncoding_Term.DeclFun uu___4 in - [uu___3] - else - (let uu___4 = FStar_Ident.range_of_lid t in - FStar_SMTEncoding_Term.constructor_to_decl uu___4 c) in - let inversion_axioms env1 tapp vars = + let quals = se.FStar_Syntax_Syntax.sigquals in + let is_logical = + FStar_Compiler_Util.for_some + (fun uu___3 -> + match uu___3 with + | FStar_Syntax_Syntax.Logic -> true + | FStar_Syntax_Syntax.Assumption -> true + | uu___4 -> false) quals in + let constructor_or_logic_type_decl c = + if is_logical + then let uu___3 = - FStar_Compiler_Util.for_some - (fun l -> - let uu___4 = - FStar_TypeChecker_Env.try_lookup_lid - env1.FStar_SMTEncoding_Env.tcenv l in - FStar_Compiler_Option.isNone uu___4) datas in - if uu___3 - then [] - else - (let uu___5 = - FStar_SMTEncoding_Env.fresh_fvar - env1.FStar_SMTEncoding_Env.current_module_name "x" - FStar_SMTEncoding_Term.Term_sort in - match uu___5 with - | (xxsym, xx) -> - let uu___6 = - FStar_Compiler_List.fold_left - (fun uu___7 -> - fun l -> - match uu___7 with - | (out, decls) -> - let is_l = - FStar_SMTEncoding_Env.mk_data_tester env1 - l xx in - let uu___8 = - let uu___9 = - is_injective_on_params || - (let uu___10 = - FStar_Options.ext_getv - "compat:injectivity" in - uu___10 <> "") in - if uu___9 - then - let uu___10 = - FStar_TypeChecker_Env.lookup_datacon - env1.FStar_SMTEncoding_Env.tcenv l in - match uu___10 with - | (uu___11, data_t) -> - let uu___12 = - FStar_Syntax_Util.arrow_formals - data_t in - (match uu___12 with - | (args, res) -> - let indices = - let uu___13 = - FStar_Syntax_Util.head_and_args_full - res in - FStar_Pervasives_Native.snd - uu___13 in - let env2 = - FStar_Compiler_List.fold_left - (fun env3 -> - fun uu___13 -> - match uu___13 with - | { - FStar_Syntax_Syntax.binder_bv - = x; - FStar_Syntax_Syntax.binder_qual - = uu___14; - FStar_Syntax_Syntax.binder_positivity - = uu___15; - FStar_Syntax_Syntax.binder_attrs - = uu___16;_} - -> - let uu___17 = - let uu___18 = - let uu___19 = - FStar_SMTEncoding_Env.mk_term_projector_name - l x in - (uu___19, - [xx]) in - FStar_SMTEncoding_Util.mkApp - uu___18 in - FStar_SMTEncoding_Env.push_term_var - env3 x uu___17) - env1 args in + let uu___4 = + let uu___5 = + FStar_Compiler_List.map + (fun f -> f.FStar_SMTEncoding_Term.field_sort) + c.FStar_SMTEncoding_Term.constr_fields in + ((c.FStar_SMTEncoding_Term.constr_name), uu___5, + FStar_SMTEncoding_Term.Term_sort, + FStar_Pervasives_Native.None) in + FStar_SMTEncoding_Term.DeclFun uu___4 in + [uu___3] + else + (let uu___4 = FStar_Ident.range_of_lid t in + FStar_SMTEncoding_Term.constructor_to_decl uu___4 c) in + let inversion_axioms env1 tapp vars = + let uu___3 = + FStar_Compiler_Util.for_some + (fun l -> + let uu___4 = + FStar_TypeChecker_Env.try_lookup_lid + env1.FStar_SMTEncoding_Env.tcenv l in + FStar_Compiler_Option.isNone uu___4) datas in + if uu___3 + then [] + else + (let uu___5 = + FStar_SMTEncoding_Env.fresh_fvar + env1.FStar_SMTEncoding_Env.current_module_name "x" + FStar_SMTEncoding_Term.Term_sort in + match uu___5 with + | (xxsym, xx) -> + let uu___6 = + FStar_Compiler_List.fold_left + (fun uu___7 -> + fun l -> + match uu___7 with + | (out, decls) -> + let is_l = + FStar_SMTEncoding_Env.mk_data_tester env1 l + xx in + let uu___8 = + let uu___9 = + injective_type_params || + (let uu___10 = + FStar_Options.ext_getv + "compat:injectivity" in + uu___10 <> "") in + if uu___9 + then + let uu___10 = + FStar_TypeChecker_Env.lookup_datacon + env1.FStar_SMTEncoding_Env.tcenv l in + match uu___10 with + | (uu___11, data_t) -> + let uu___12 = + FStar_Syntax_Util.arrow_formals + data_t in + (match uu___12 with + | (args, res) -> + let indices = let uu___13 = - FStar_SMTEncoding_EncodeTerm.encode_args - indices env2 in - (match uu___13 with - | (indices1, decls') -> - (if - (FStar_Compiler_List.length - indices1) - <> - (FStar_Compiler_List.length - vars) - then - FStar_Compiler_Effect.failwith - "Impossible" - else (); - (let eqs = - FStar_Compiler_List.map2 - (fun v -> - fun a -> - let uu___15 = - let uu___16 - = - FStar_SMTEncoding_Util.mkFreeV - v in - (uu___16, a) in - FStar_SMTEncoding_Util.mkEq - uu___15) - vars indices1 in - let uu___15 = - let uu___16 = + FStar_Syntax_Util.head_and_args_full + res in + FStar_Pervasives_Native.snd + uu___13 in + let env2 = + FStar_Compiler_List.fold_left + (fun env3 -> + fun uu___13 -> + match uu___13 with + | { + FStar_Syntax_Syntax.binder_bv + = x; + FStar_Syntax_Syntax.binder_qual + = uu___14; + FStar_Syntax_Syntax.binder_positivity + = uu___15; + FStar_Syntax_Syntax.binder_attrs + = uu___16;_} + -> let uu___17 = - FStar_SMTEncoding_Util.mk_and_l - eqs in - (is_l, uu___17) in - FStar_SMTEncoding_Util.mkAnd - uu___16 in - (uu___15, decls'))))) - else (is_l, []) in - (match uu___8 with - | (inversion_case, decls') -> - let uu___9 = - FStar_SMTEncoding_Util.mkOr - (out, inversion_case) in - (uu___9, - (FStar_Compiler_List.op_At decls - decls')))) - (FStar_SMTEncoding_Util.mkFalse, []) datas in - (match uu___6 with - | (data_ax, decls) -> - let uu___7 = - FStar_SMTEncoding_Env.fresh_fvar - env1.FStar_SMTEncoding_Env.current_module_name - "f" FStar_SMTEncoding_Term.Fuel_sort in - (match uu___7 with - | (ffsym, ff) -> - let fuel_guarded_inversion = - let xx_has_type_sfuel = - if - (FStar_Compiler_List.length datas) > - Prims.int_one - then - let uu___8 = - FStar_SMTEncoding_Util.mkApp - ("SFuel", [ff]) in - FStar_SMTEncoding_Term.mk_HasTypeFuel - uu___8 xx tapp - else - FStar_SMTEncoding_Term.mk_HasTypeFuel ff - xx tapp in - let uu___8 = - let uu___9 = - let uu___10 = FStar_Ident.range_of_lid t in - let uu___11 = - let uu___12 = - let uu___13 = - FStar_SMTEncoding_Term.mk_fv - (ffsym, - FStar_SMTEncoding_Term.Fuel_sort) in - let uu___14 = - let uu___15 = - FStar_SMTEncoding_Term.mk_fv - (xxsym, - FStar_SMTEncoding_Term.Term_sort) in - uu___15 :: vars in - FStar_SMTEncoding_Env.add_fuel - uu___13 uu___14 in - let uu___13 = - FStar_SMTEncoding_Util.mkImp - (xx_has_type_sfuel, data_ax) in - ([[xx_has_type_sfuel]], uu___12, - uu___13) in - FStar_SMTEncoding_Term.mkForall uu___10 - uu___11 in - let uu___10 = - let uu___11 = - let uu___12 = - FStar_Ident.string_of_lid t in - Prims.strcat "fuel_guarded_inversion_" - uu___12 in - FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.mk_unique - uu___11 in - (uu___9, - (FStar_Pervasives_Native.Some - "inversion axiom"), uu___10) in - FStar_SMTEncoding_Util.mkAssume uu___8 in - let uu___8 = - FStar_SMTEncoding_Term.mk_decls_trivial - [fuel_guarded_inversion] in - FStar_Compiler_List.op_At decls uu___8))) in - let uu___3 = - let k1 = - match tps with - | [] -> k - | uu___4 -> - let uu___5 = - let uu___6 = - let uu___7 = FStar_Syntax_Syntax.mk_Total k in - { - FStar_Syntax_Syntax.bs1 = tps; - FStar_Syntax_Syntax.comp = uu___7 - } in - FStar_Syntax_Syntax.Tm_arrow uu___6 in - FStar_Syntax_Syntax.mk uu___5 k.FStar_Syntax_Syntax.pos in - let k2 = norm_before_encoding env k1 in - FStar_Syntax_Util.arrow_formals k2 in - (match uu___3 with - | (formals, res) -> - let uu___4 = - FStar_SMTEncoding_EncodeTerm.encode_binders - FStar_Pervasives_Native.None formals env in - (match uu___4 with - | (vars, guards, env', binder_decls, uu___5) -> - let arity = FStar_Compiler_List.length vars in - let uu___6 = - FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid - env t arity in - (match uu___6 with - | (tname, ttok, env1) -> - let ttok_tm = - FStar_SMTEncoding_Util.mkApp (ttok, []) in - let guard = FStar_SMTEncoding_Util.mk_and_l guards in - let tapp = - let uu___7 = - let uu___8 = - FStar_Compiler_List.map - FStar_SMTEncoding_Util.mkFreeV vars in - (tname, uu___8) in - FStar_SMTEncoding_Util.mkApp uu___7 in - let uu___7 = - let tname_decl = + let uu___18 = + let uu___19 = + FStar_SMTEncoding_Env.mk_term_projector_name + l x in + (uu___19, [xx]) in + FStar_SMTEncoding_Util.mkApp + uu___18 in + FStar_SMTEncoding_Env.push_term_var + env3 x uu___17) + env1 args in + let uu___13 = + FStar_SMTEncoding_EncodeTerm.encode_args + indices env2 in + (match uu___13 with + | (indices1, decls') -> + (if + (FStar_Compiler_List.length + indices1) + <> + (FStar_Compiler_List.length + vars) + then + FStar_Compiler_Effect.failwith + "Impossible" + else (); + (let eqs = + FStar_Compiler_List.map2 + (fun v -> + fun a -> + let uu___15 = + let uu___16 = + FStar_SMTEncoding_Util.mkFreeV + v in + (uu___16, a) in + FStar_SMTEncoding_Util.mkEq + uu___15) vars + indices1 in + let uu___15 = + let uu___16 = + let uu___17 = + FStar_SMTEncoding_Util.mk_and_l + eqs in + (is_l, uu___17) in + FStar_SMTEncoding_Util.mkAnd + uu___16 in + (uu___15, decls'))))) + else (is_l, []) in + (match uu___8 with + | (inversion_case, decls') -> + let uu___9 = + FStar_SMTEncoding_Util.mkOr + (out, inversion_case) in + (uu___9, + (FStar_Compiler_List.op_At decls + decls')))) + (FStar_SMTEncoding_Util.mkFalse, []) datas in + (match uu___6 with + | (data_ax, decls) -> + let uu___7 = + FStar_SMTEncoding_Env.fresh_fvar + env1.FStar_SMTEncoding_Env.current_module_name + "f" FStar_SMTEncoding_Term.Fuel_sort in + (match uu___7 with + | (ffsym, ff) -> + let fuel_guarded_inversion = + let xx_has_type_sfuel = + if + (FStar_Compiler_List.length datas) > + Prims.int_one + then + let uu___8 = + FStar_SMTEncoding_Util.mkApp + ("SFuel", [ff]) in + FStar_SMTEncoding_Term.mk_HasTypeFuel + uu___8 xx tapp + else + FStar_SMTEncoding_Term.mk_HasTypeFuel ff + xx tapp in let uu___8 = let uu___9 = - FStar_Compiler_List.map - (fun fv -> - let uu___10 = - let uu___11 = - FStar_SMTEncoding_Term.fv_name fv in - Prims.strcat tname uu___11 in - let uu___11 = - FStar_SMTEncoding_Term.fv_sort fv in - { - FStar_SMTEncoding_Term.field_name = - uu___10; - FStar_SMTEncoding_Term.field_sort = - uu___11; - FStar_SMTEncoding_Term.field_projectible - = false - }) vars in + let uu___10 = FStar_Ident.range_of_lid t in + let uu___11 = + let uu___12 = + let uu___13 = + FStar_SMTEncoding_Term.mk_fv + (ffsym, + FStar_SMTEncoding_Term.Fuel_sort) in + let uu___14 = + let uu___15 = + FStar_SMTEncoding_Term.mk_fv + (xxsym, + FStar_SMTEncoding_Term.Term_sort) in + uu___15 :: vars in + FStar_SMTEncoding_Env.add_fuel uu___13 + uu___14 in + let uu___13 = + FStar_SMTEncoding_Util.mkImp + (xx_has_type_sfuel, data_ax) in + ([[xx_has_type_sfuel]], uu___12, + uu___13) in + FStar_SMTEncoding_Term.mkForall uu___10 + uu___11 in let uu___10 = let uu___11 = + let uu___12 = + FStar_Ident.string_of_lid t in + Prims.strcat "fuel_guarded_inversion_" + uu___12 in + FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.mk_unique + uu___11 in + (uu___9, + (FStar_Pervasives_Native.Some + "inversion axiom"), uu___10) in + FStar_SMTEncoding_Util.mkAssume uu___8 in + let uu___8 = + FStar_SMTEncoding_Term.mk_decls_trivial + [fuel_guarded_inversion] in + FStar_Compiler_List.op_At decls uu___8))) in + let uu___3 = + let k1 = + match tps with + | [] -> k + | uu___4 -> + let uu___5 = + let uu___6 = + let uu___7 = FStar_Syntax_Syntax.mk_Total k in + { + FStar_Syntax_Syntax.bs1 = tps; + FStar_Syntax_Syntax.comp = uu___7 + } in + FStar_Syntax_Syntax.Tm_arrow uu___6 in + FStar_Syntax_Syntax.mk uu___5 k.FStar_Syntax_Syntax.pos in + let k2 = norm_before_encoding env k1 in + FStar_Syntax_Util.arrow_formals k2 in + (match uu___3 with + | (formals, res) -> + let uu___4 = + FStar_SMTEncoding_EncodeTerm.encode_binders + FStar_Pervasives_Native.None formals env in + (match uu___4 with + | (vars, guards, env', binder_decls, uu___5) -> + let arity = FStar_Compiler_List.length vars in + let uu___6 = + FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid + env t arity in + (match uu___6 with + | (tname, ttok, env1) -> + let ttok_tm = + FStar_SMTEncoding_Util.mkApp (ttok, []) in + let guard = FStar_SMTEncoding_Util.mk_and_l guards in + let tapp = + let uu___7 = + let uu___8 = + FStar_Compiler_List.map + FStar_SMTEncoding_Util.mkFreeV vars in + (tname, uu___8) in + FStar_SMTEncoding_Util.mkApp uu___7 in + let uu___7 = + let tname_decl = + let uu___8 = + let uu___9 = + FStar_Compiler_List.map + (fun fv -> + let uu___10 = + let uu___11 = + FStar_SMTEncoding_Term.fv_name fv in + Prims.strcat tname uu___11 in + let uu___11 = + FStar_SMTEncoding_Term.fv_sort fv in + { + FStar_SMTEncoding_Term.field_name = + uu___10; + FStar_SMTEncoding_Term.field_sort = + uu___11; + FStar_SMTEncoding_Term.field_projectible + = false + }) vars in + let uu___10 = + let uu___11 = + FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id + () in + FStar_Pervasives_Native.Some uu___11 in + { + FStar_SMTEncoding_Term.constr_name = tname; + FStar_SMTEncoding_Term.constr_fields = + uu___9; + FStar_SMTEncoding_Term.constr_sort = + FStar_SMTEncoding_Term.Term_sort; + FStar_SMTEncoding_Term.constr_id = uu___10; + FStar_SMTEncoding_Term.constr_base = false + } in + constructor_or_logic_type_decl uu___8 in + let uu___8 = + match vars with + | [] -> + let uu___9 = + let uu___10 = + let uu___11 = + FStar_SMTEncoding_Util.mkApp + (tname, []) in + FStar_Pervasives_Native.Some uu___11 in + FStar_SMTEncoding_Env.push_free_var env1 t + arity tname uu___10 in + ([], uu___9) + | uu___9 -> + let ttok_decl = + FStar_SMTEncoding_Term.DeclFun + (ttok, [], + FStar_SMTEncoding_Term.Term_sort, + (FStar_Pervasives_Native.Some "token")) in + let ttok_fresh = + let uu___10 = FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id () in - FStar_Pervasives_Native.Some uu___11 in - { - FStar_SMTEncoding_Term.constr_name = tname; - FStar_SMTEncoding_Term.constr_fields = - uu___9; - FStar_SMTEncoding_Term.constr_sort = - FStar_SMTEncoding_Term.Term_sort; - FStar_SMTEncoding_Term.constr_id = uu___10; - FStar_SMTEncoding_Term.constr_base = false - } in - constructor_or_logic_type_decl uu___8 in - let uu___8 = - match vars with - | [] -> - let uu___9 = - let uu___10 = - let uu___11 = - FStar_SMTEncoding_Util.mkApp - (tname, []) in - FStar_Pervasives_Native.Some uu___11 in - FStar_SMTEncoding_Env.push_free_var env1 - t arity tname uu___10 in - ([], uu___9) - | uu___9 -> - let ttok_decl = - FStar_SMTEncoding_Term.DeclFun - (ttok, [], - FStar_SMTEncoding_Term.Term_sort, - (FStar_Pervasives_Native.Some - "token")) in - let ttok_fresh = - let uu___10 = - FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id - () in - FStar_SMTEncoding_Term.fresh_token - (ttok, - FStar_SMTEncoding_Term.Term_sort) - uu___10 in - let ttok_app = - FStar_SMTEncoding_EncodeTerm.mk_Apply - ttok_tm vars in - let pats = [[ttok_app]; [tapp]] in - let name_tok_corr = - let uu___10 = - let uu___11 = - let uu___12 = - FStar_Ident.range_of_lid t in - let uu___13 = - let uu___14 = - FStar_SMTEncoding_Util.mkEq - (ttok_app, tapp) in - (pats, - FStar_Pervasives_Native.None, - vars, uu___14) in - FStar_SMTEncoding_Term.mkForall' - uu___12 uu___13 in - (uu___11, - (FStar_Pervasives_Native.Some - "name-token correspondence"), - (Prims.strcat - "token_correspondence_" ttok)) in - FStar_SMTEncoding_Util.mkAssume uu___10 in - ([ttok_decl; ttok_fresh; name_tok_corr], - env1) in - match uu___8 with - | (tok_decls, env2) -> - ((FStar_Compiler_List.op_At tname_decl - tok_decls), env2) in - (match uu___7 with - | (decls, env2) -> - let kindingAx = - let uu___8 = - FStar_SMTEncoding_EncodeTerm.encode_term_pred - FStar_Pervasives_Native.None res env' - tapp in - match uu___8 with - | (k1, decls1) -> - let karr = - if - (FStar_Compiler_List.length formals) - > Prims.int_zero - then - let uu___9 = - let uu___10 = - let uu___11 = - let uu___12 = - FStar_SMTEncoding_Term.mk_PreType - ttok_tm in - FStar_SMTEncoding_Term.mk_tester - "Tm_arrow" uu___12 in - (uu___11, - (FStar_Pervasives_Native.Some - "kinding"), - (Prims.strcat "pre_kinding_" - ttok)) in - FStar_SMTEncoding_Util.mkAssume - uu___10 in - [uu___9] - else [] in - let rng = FStar_Ident.range_of_lid t in - let tot_fun_axioms = + FStar_SMTEncoding_Term.fresh_token + (ttok, FStar_SMTEncoding_Term.Term_sort) + uu___10 in + let ttok_app = + FStar_SMTEncoding_EncodeTerm.mk_Apply + ttok_tm vars in + let pats = [[ttok_app]; [tapp]] in + let name_tok_corr = + let uu___10 = + let uu___11 = + let uu___12 = + FStar_Ident.range_of_lid t in + let uu___13 = + let uu___14 = + FStar_SMTEncoding_Util.mkEq + (ttok_app, tapp) in + (pats, FStar_Pervasives_Native.None, + vars, uu___14) in + FStar_SMTEncoding_Term.mkForall' + uu___12 uu___13 in + (uu___11, + (FStar_Pervasives_Native.Some + "name-token correspondence"), + (Prims.strcat "token_correspondence_" + ttok)) in + FStar_SMTEncoding_Util.mkAssume uu___10 in + ([ttok_decl; ttok_fresh; name_tok_corr], + env1) in + match uu___8 with + | (tok_decls, env2) -> + ((FStar_Compiler_List.op_At tname_decl + tok_decls), env2) in + (match uu___7 with + | (decls, env2) -> + let kindingAx = + let uu___8 = + FStar_SMTEncoding_EncodeTerm.encode_term_pred + FStar_Pervasives_Native.None res env' + tapp in + match uu___8 with + | (k1, decls1) -> + let karr = + if + (FStar_Compiler_List.length formals) + > Prims.int_zero + then let uu___9 = - FStar_Compiler_List.map - (fun uu___10 -> - FStar_SMTEncoding_Util.mkTrue) - vars in - FStar_SMTEncoding_EncodeTerm.isTotFun_axioms - rng ttok_tm vars uu___9 true in + let uu___10 = + let uu___11 = + let uu___12 = + FStar_SMTEncoding_Term.mk_PreType + ttok_tm in + FStar_SMTEncoding_Term.mk_tester + "Tm_arrow" uu___12 in + (uu___11, + (FStar_Pervasives_Native.Some + "kinding"), + (Prims.strcat "pre_kinding_" + ttok)) in + FStar_SMTEncoding_Util.mkAssume + uu___10 in + [uu___9] + else [] in + let rng = FStar_Ident.range_of_lid t in + let tot_fun_axioms = let uu___9 = - let uu___10 = - let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = - let uu___15 = - let uu___16 = - let uu___17 = - let uu___18 = - FStar_SMTEncoding_Util.mkImp - (guard, k1) in - ([[tapp]], vars, - uu___18) in - FStar_SMTEncoding_Term.mkForall - rng uu___17 in - (tot_fun_axioms, uu___16) in - FStar_SMTEncoding_Util.mkAnd - uu___15 in - (uu___14, - FStar_Pervasives_Native.None, - (Prims.strcat "kinding_" - ttok)) in - FStar_SMTEncoding_Util.mkAssume - uu___13 in - [uu___12] in - FStar_Compiler_List.op_At karr - uu___11 in - FStar_SMTEncoding_Term.mk_decls_trivial - uu___10 in - FStar_Compiler_List.op_At decls1 uu___9 in - let aux = - let uu___8 = + FStar_Compiler_List.map + (fun uu___10 -> + FStar_SMTEncoding_Util.mkTrue) + vars in + FStar_SMTEncoding_EncodeTerm.isTotFun_axioms + rng ttok_tm vars uu___9 true in let uu___9 = - inversion_axioms env2 tapp vars in - let uu___10 = - let uu___11 = - let uu___12 = - let uu___13 = - FStar_Ident.range_of_lid t in - pretype_axiom - (Prims.op_Negation - is_injective_on_params) - uu___13 env2 tapp vars in - [uu___12] in + let uu___10 = + let uu___11 = + let uu___12 = + let uu___13 = + let uu___14 = + let uu___15 = + let uu___16 = + let uu___17 = + let uu___18 = + FStar_SMTEncoding_Util.mkImp + (guard, k1) in + ([[tapp]], vars, + uu___18) in + FStar_SMTEncoding_Term.mkForall + rng uu___17 in + (tot_fun_axioms, uu___16) in + FStar_SMTEncoding_Util.mkAnd + uu___15 in + (uu___14, + FStar_Pervasives_Native.None, + (Prims.strcat "kinding_" ttok)) in + FStar_SMTEncoding_Util.mkAssume + uu___13 in + [uu___12] in + FStar_Compiler_List.op_At karr + uu___11 in FStar_SMTEncoding_Term.mk_decls_trivial - uu___11 in - FStar_Compiler_List.op_At uu___9 uu___10 in - FStar_Compiler_List.op_At kindingAx uu___8 in + uu___10 in + FStar_Compiler_List.op_At decls1 uu___9 in + let aux = let uu___8 = let uu___9 = + inversion_axioms env2 tapp vars in + let uu___10 = + let uu___11 = + let uu___12 = + let uu___13 = + FStar_Ident.range_of_lid t in + pretype_axiom + (Prims.op_Negation + injective_type_params) uu___13 + env2 tapp vars in + [uu___12] in FStar_SMTEncoding_Term.mk_decls_trivial - decls in - FStar_Compiler_List.op_At uu___9 - (FStar_Compiler_List.op_At binder_decls - aux) in - (uu___8, env2))))) + uu___11 in + FStar_Compiler_List.op_At uu___9 uu___10 in + FStar_Compiler_List.op_At kindingAx uu___8 in + let uu___8 = + let uu___9 = + FStar_SMTEncoding_Term.mk_decls_trivial + decls in + FStar_Compiler_List.op_At uu___9 + (FStar_Compiler_List.op_At binder_decls aux) in + (uu___8, env2))))) let (encode_datacon : - Prims.bool -> - FStar_SMTEncoding_Env.env_t -> - FStar_Syntax_Syntax.sigelt -> - (FStar_SMTEncoding_Term.decls_t * FStar_SMTEncoding_Env.env_t)) + FStar_SMTEncoding_Env.env_t -> + FStar_Syntax_Syntax.sigelt -> + (FStar_SMTEncoding_Term.decls_t * FStar_SMTEncoding_Env.env_t)) = - fun is_injective_on_tparams -> - fun env -> - fun se -> - let uu___ = se.FStar_Syntax_Syntax.sigel in - match uu___ with - | FStar_Syntax_Syntax.Sig_datacon - { FStar_Syntax_Syntax.lid1 = d; FStar_Syntax_Syntax.us1 = uu___1; - FStar_Syntax_Syntax.t1 = t; - FStar_Syntax_Syntax.ty_lid = uu___2; - FStar_Syntax_Syntax.num_ty_params = n_tps; - FStar_Syntax_Syntax.mutuals1 = mutuals;_} - -> - let quals = se.FStar_Syntax_Syntax.sigquals in - let t1 = norm_before_encoding env t in - let uu___3 = FStar_Syntax_Util.arrow_formals t1 in - (match uu___3 with - | (formals, t_res) -> - let arity = FStar_Compiler_List.length formals in - let uu___4 = - FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid - env d arity in - (match uu___4 with - | (ddconstrsym, ddtok, env1) -> - let ddtok_tm = FStar_SMTEncoding_Util.mkApp (ddtok, []) in - let uu___5 = - FStar_SMTEncoding_Env.fresh_fvar - env1.FStar_SMTEncoding_Env.current_module_name "f" - FStar_SMTEncoding_Term.Fuel_sort in - (match uu___5 with - | (fuel_var, fuel_tm) -> - let s_fuel_tm = - FStar_SMTEncoding_Util.mkApp - ("SFuel", [fuel_tm]) in - let uu___6 = - FStar_SMTEncoding_EncodeTerm.encode_binders - (FStar_Pervasives_Native.Some fuel_tm) formals - env1 in - (match uu___6 with - | (vars, guards, env', binder_decls, names) -> - let is_injective_on_tparams1 = - is_injective_on_tparams || - (let uu___7 = - FStar_Options.ext_getv - "compat:injectivity" in - uu___7 <> "") in - let fields = - FStar_Compiler_List.mapi - (fun n -> - fun x -> - let field_projectible = - (n >= n_tps) || - is_injective_on_tparams1 in - let uu___7 = - FStar_SMTEncoding_Env.mk_term_projector_name - d x in - { - FStar_SMTEncoding_Term.field_name - = uu___7; - FStar_SMTEncoding_Term.field_sort - = - FStar_SMTEncoding_Term.Term_sort; - FStar_SMTEncoding_Term.field_projectible - = field_projectible - }) names in - let datacons = - let uu___7 = FStar_Ident.range_of_lid d in - let uu___8 = - let uu___9 = - let uu___10 = - FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id - () in - FStar_Pervasives_Native.Some uu___10 in - { - FStar_SMTEncoding_Term.constr_name = - ddconstrsym; - FStar_SMTEncoding_Term.constr_fields = - fields; - FStar_SMTEncoding_Term.constr_sort = - FStar_SMTEncoding_Term.Term_sort; - FStar_SMTEncoding_Term.constr_id = - uu___9; - FStar_SMTEncoding_Term.constr_base = - (Prims.op_Negation - is_injective_on_tparams1) - } in - FStar_SMTEncoding_Term.constructor_to_decl - uu___7 uu___8 in - let app = - FStar_SMTEncoding_EncodeTerm.mk_Apply - ddtok_tm vars in - let guard = - FStar_SMTEncoding_Util.mk_and_l guards in - let xvars = - FStar_Compiler_List.map - FStar_SMTEncoding_Util.mkFreeV vars in - let dapp = - FStar_SMTEncoding_Util.mkApp - (ddconstrsym, xvars) in - let uu___7 = - FStar_SMTEncoding_EncodeTerm.encode_term_pred - FStar_Pervasives_Native.None t1 env1 - ddtok_tm in - (match uu___7 with - | (tok_typing, decls3) -> - let tok_typing1 = - match fields with - | uu___8::uu___9 -> - let ff = - FStar_SMTEncoding_Term.mk_fv - ("ty", - FStar_SMTEncoding_Term.Term_sort) in - let f = - FStar_SMTEncoding_Util.mkFreeV - ff in - let vtok_app_l = - FStar_SMTEncoding_EncodeTerm.mk_Apply - ddtok_tm [ff] in - let vtok_app_r = - let uu___10 = - let uu___11 = - FStar_SMTEncoding_Term.mk_fv - (ddtok, - FStar_SMTEncoding_Term.Term_sort) in - [uu___11] in - FStar_SMTEncoding_EncodeTerm.mk_Apply - f uu___10 in - let uu___10 = - FStar_Ident.range_of_lid d in - let uu___11 = - let uu___12 = - FStar_SMTEncoding_Term.mk_NoHoist - f tok_typing in - ([[vtok_app_l]; [vtok_app_r]], - [ff], uu___12) in - FStar_SMTEncoding_Term.mkForall - uu___10 uu___11 - | uu___8 -> tok_typing in - let uu___8 = - let uu___9 = - FStar_SMTEncoding_EncodeTerm.encode_term - t_res env' in - match uu___9 with - | (t_res_tm, t_res_decls) -> + fun env -> + fun se -> + let uu___ = se.FStar_Syntax_Syntax.sigel in + match uu___ with + | FStar_Syntax_Syntax.Sig_datacon + { FStar_Syntax_Syntax.lid1 = d; FStar_Syntax_Syntax.us1 = uu___1; + FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; + FStar_Syntax_Syntax.num_ty_params = n_tps; + FStar_Syntax_Syntax.mutuals1 = mutuals; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params;_} + -> + let quals = se.FStar_Syntax_Syntax.sigquals in + let t1 = norm_before_encoding env t in + let uu___3 = FStar_Syntax_Util.arrow_formals t1 in + (match uu___3 with + | (formals, t_res) -> + let arity = FStar_Compiler_List.length formals in + let uu___4 = + FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid env + d arity in + (match uu___4 with + | (ddconstrsym, ddtok, env1) -> + let ddtok_tm = FStar_SMTEncoding_Util.mkApp (ddtok, []) in + let uu___5 = + FStar_SMTEncoding_Env.fresh_fvar + env1.FStar_SMTEncoding_Env.current_module_name "f" + FStar_SMTEncoding_Term.Fuel_sort in + (match uu___5 with + | (fuel_var, fuel_tm) -> + let s_fuel_tm = + FStar_SMTEncoding_Util.mkApp ("SFuel", [fuel_tm]) in + let uu___6 = + FStar_SMTEncoding_EncodeTerm.encode_binders + (FStar_Pervasives_Native.Some fuel_tm) formals + env1 in + (match uu___6 with + | (vars, guards, env', binder_decls, names) -> + let injective_type_params1 = + injective_type_params || + (let uu___7 = + FStar_Options.ext_getv + "compat:injectivity" in + uu___7 <> "") in + let fields = + FStar_Compiler_List.mapi + (fun n -> + fun x -> + let field_projectible = + (n >= n_tps) || + injective_type_params1 in + let uu___7 = + FStar_SMTEncoding_Env.mk_term_projector_name + d x in + { + FStar_SMTEncoding_Term.field_name = + uu___7; + FStar_SMTEncoding_Term.field_sort = + FStar_SMTEncoding_Term.Term_sort; + FStar_SMTEncoding_Term.field_projectible + = field_projectible + }) names in + let datacons = + let uu___7 = FStar_Ident.range_of_lid d in + let uu___8 = + let uu___9 = + let uu___10 = + FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id + () in + FStar_Pervasives_Native.Some uu___10 in + { + FStar_SMTEncoding_Term.constr_name = + ddconstrsym; + FStar_SMTEncoding_Term.constr_fields = + fields; + FStar_SMTEncoding_Term.constr_sort = + FStar_SMTEncoding_Term.Term_sort; + FStar_SMTEncoding_Term.constr_id = uu___9; + FStar_SMTEncoding_Term.constr_base = + (Prims.op_Negation + injective_type_params1) + } in + FStar_SMTEncoding_Term.constructor_to_decl + uu___7 uu___8 in + let app = + FStar_SMTEncoding_EncodeTerm.mk_Apply + ddtok_tm vars in + let guard = + FStar_SMTEncoding_Util.mk_and_l guards in + let xvars = + FStar_Compiler_List.map + FStar_SMTEncoding_Util.mkFreeV vars in + let dapp = + FStar_SMTEncoding_Util.mkApp + (ddconstrsym, xvars) in + let uu___7 = + FStar_SMTEncoding_EncodeTerm.encode_term_pred + FStar_Pervasives_Native.None t1 env1 + ddtok_tm in + (match uu___7 with + | (tok_typing, decls3) -> + let tok_typing1 = + match fields with + | uu___8::uu___9 -> + let ff = + FStar_SMTEncoding_Term.mk_fv + ("ty", + FStar_SMTEncoding_Term.Term_sort) in + let f = + FStar_SMTEncoding_Util.mkFreeV ff in + let vtok_app_l = + FStar_SMTEncoding_EncodeTerm.mk_Apply + ddtok_tm [ff] in + let vtok_app_r = let uu___10 = - FStar_SMTEncoding_Term.mk_HasTypeWithFuel - (FStar_Pervasives_Native.Some - fuel_tm) dapp t_res_tm in - (uu___10, t_res_tm, t_res_decls) in - (match uu___8 with - | (ty_pred', t_res_tm, decls_pred) -> - let proxy_fresh = - match formals with - | [] -> [] - | uu___9 -> - let uu___10 = - let uu___11 = - FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id - () in - FStar_SMTEncoding_Term.fresh_token - (ddtok, - FStar_SMTEncoding_Term.Term_sort) - uu___11 in - [uu___10] in - let encode_elim uu___9 = - let uu___10 = - FStar_Syntax_Util.head_and_args - t_res in - match uu___10 with - | (head, args) -> + let uu___11 = + FStar_SMTEncoding_Term.mk_fv + (ddtok, + FStar_SMTEncoding_Term.Term_sort) in + [uu___11] in + FStar_SMTEncoding_EncodeTerm.mk_Apply + f uu___10 in + let uu___10 = + FStar_Ident.range_of_lid d in + let uu___11 = + let uu___12 = + FStar_SMTEncoding_Term.mk_NoHoist + f tok_typing in + ([[vtok_app_l]; [vtok_app_r]], + [ff], uu___12) in + FStar_SMTEncoding_Term.mkForall + uu___10 uu___11 + | uu___8 -> tok_typing in + let uu___8 = + let uu___9 = + FStar_SMTEncoding_EncodeTerm.encode_term + t_res env' in + match uu___9 with + | (t_res_tm, t_res_decls) -> + let uu___10 = + FStar_SMTEncoding_Term.mk_HasTypeWithFuel + (FStar_Pervasives_Native.Some + fuel_tm) dapp t_res_tm in + (uu___10, t_res_tm, t_res_decls) in + (match uu___8 with + | (ty_pred', t_res_tm, decls_pred) -> + let proxy_fresh = + match formals with + | [] -> [] + | uu___9 -> + let uu___10 = let uu___11 = - let uu___12 = - FStar_Syntax_Subst.compress - head in - uu___12.FStar_Syntax_Syntax.n in - (match uu___11 with - | FStar_Syntax_Syntax.Tm_uinst - ({ - FStar_Syntax_Syntax.n - = - FStar_Syntax_Syntax.Tm_fvar - fv; - FStar_Syntax_Syntax.pos - = uu___12; - FStar_Syntax_Syntax.vars - = uu___13; - FStar_Syntax_Syntax.hash_code - = uu___14;_}, - uu___15) - -> - let encoded_head_fvb = - FStar_SMTEncoding_Env.lookup_free_var_name - env' - fv.FStar_Syntax_Syntax.fv_name in - let uu___16 = - FStar_SMTEncoding_EncodeTerm.encode_args - args env' in - (match uu___16 with - | (encoded_args, - arg_decls) -> - let uu___17 = - let uu___18 = - FStar_Compiler_List.zip - args - encoded_args in - FStar_Compiler_List.fold_left - (fun uu___19 -> - fun uu___20 - -> - match - (uu___19, + FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id + () in + FStar_SMTEncoding_Term.fresh_token + (ddtok, + FStar_SMTEncoding_Term.Term_sort) + uu___11 in + [uu___10] in + let encode_elim uu___9 = + let uu___10 = + FStar_Syntax_Util.head_and_args + t_res in + match uu___10 with + | (head, args) -> + let uu___11 = + let uu___12 = + FStar_Syntax_Subst.compress + head in + uu___12.FStar_Syntax_Syntax.n in + (match uu___11 with + | FStar_Syntax_Syntax.Tm_uinst + ({ + FStar_Syntax_Syntax.n = + FStar_Syntax_Syntax.Tm_fvar + fv; + FStar_Syntax_Syntax.pos + = uu___12; + FStar_Syntax_Syntax.vars + = uu___13; + FStar_Syntax_Syntax.hash_code + = uu___14;_}, + uu___15) + -> + let encoded_head_fvb = + FStar_SMTEncoding_Env.lookup_free_var_name + env' + fv.FStar_Syntax_Syntax.fv_name in + let uu___16 = + FStar_SMTEncoding_EncodeTerm.encode_args + args env' in + (match uu___16 with + | (encoded_args, + arg_decls) -> + let uu___17 = + let uu___18 = + FStar_Compiler_List.zip + args + encoded_args in + FStar_Compiler_List.fold_left + (fun uu___19 -> + fun uu___20 -> + match + (uu___19, uu___20) - with - | - ((env2, + with + | ((env2, arg_vars, eqns_or_guards, i), @@ -4717,36 +4488,34 @@ let (encode_datacon : eqns, (i + Prims.int_one)))) - (env', [], [], - Prims.int_zero) - uu___18 in - (match uu___17 with - | (uu___18, - arg_vars, - elim_eqns_or_guards, - uu___19) -> - let arg_vars1 - = - FStar_Compiler_List.rev - arg_vars in - let uu___20 = - FStar_Compiler_List.splitAt - n_tps - arg_vars1 in - (match uu___20 - with - | (arg_params, - uu___21) - -> - let uu___22 + (env', [], [], + Prims.int_zero) + uu___18 in + (match uu___17 with + | (uu___18, + arg_vars, + elim_eqns_or_guards, + uu___19) -> + let arg_vars1 = + FStar_Compiler_List.rev + arg_vars in + let uu___20 = + FStar_Compiler_List.splitAt + n_tps + arg_vars1 in + (match uu___20 + with + | (arg_params, + uu___21) -> + let uu___22 = FStar_Compiler_List.splitAt n_tps vars in - (match uu___22 - with - | - (data_arg_params, + (match uu___22 + with + | + (data_arg_params, uu___23) -> let elim_eqns_and_guards @@ -5393,33 +5162,31 @@ let (encode_datacon : [typing_inversion; subterm_ordering] codomain_ordering))))))) - | FStar_Syntax_Syntax.Tm_fvar - fv -> - let encoded_head_fvb = - FStar_SMTEncoding_Env.lookup_free_var_name - env' - fv.FStar_Syntax_Syntax.fv_name in - let uu___12 = - FStar_SMTEncoding_EncodeTerm.encode_args - args env' in - (match uu___12 with - | (encoded_args, - arg_decls) -> - let uu___13 = - let uu___14 = - FStar_Compiler_List.zip - args - encoded_args in - FStar_Compiler_List.fold_left - (fun uu___15 -> - fun uu___16 - -> - match - (uu___15, + | FStar_Syntax_Syntax.Tm_fvar + fv -> + let encoded_head_fvb = + FStar_SMTEncoding_Env.lookup_free_var_name + env' + fv.FStar_Syntax_Syntax.fv_name in + let uu___12 = + FStar_SMTEncoding_EncodeTerm.encode_args + args env' in + (match uu___12 with + | (encoded_args, + arg_decls) -> + let uu___13 = + let uu___14 = + FStar_Compiler_List.zip + args + encoded_args in + FStar_Compiler_List.fold_left + (fun uu___15 -> + fun uu___16 -> + match + (uu___15, uu___16) - with - | - ((env2, + with + | ((env2, arg_vars, eqns_or_guards, i), @@ -5461,36 +5228,34 @@ let (encode_datacon : eqns, (i + Prims.int_one)))) - (env', [], [], - Prims.int_zero) - uu___14 in - (match uu___13 with - | (uu___14, - arg_vars, - elim_eqns_or_guards, - uu___15) -> - let arg_vars1 - = - FStar_Compiler_List.rev - arg_vars in - let uu___16 = - FStar_Compiler_List.splitAt - n_tps - arg_vars1 in - (match uu___16 - with - | (arg_params, - uu___17) - -> - let uu___18 + (env', [], [], + Prims.int_zero) + uu___14 in + (match uu___13 with + | (uu___14, + arg_vars, + elim_eqns_or_guards, + uu___15) -> + let arg_vars1 = + FStar_Compiler_List.rev + arg_vars in + let uu___16 = + FStar_Compiler_List.splitAt + n_tps + arg_vars1 in + (match uu___16 + with + | (arg_params, + uu___17) -> + let uu___18 = FStar_Compiler_List.splitAt n_tps vars in - (match uu___18 - with - | - (data_arg_params, + (match uu___18 + with + | + (data_arg_params, uu___19) -> let elim_eqns_and_guards @@ -6137,62 +5902,59 @@ let (encode_datacon : [typing_inversion; subterm_ordering] codomain_ordering))))))) - | uu___12 -> - ((let uu___14 = - let uu___15 = - let uu___16 = - FStar_Syntax_Print.lid_to_string - d in - let uu___17 = - FStar_Syntax_Print.term_to_string - head in - FStar_Compiler_Util.format2 - "Constructor %s builds an unexpected type %s\n" - uu___16 uu___17 in - (FStar_Errors_Codes.Warning_ConstructorBuildsUnexpectedType, - uu___15) in - FStar_Errors.log_issue - se.FStar_Syntax_Syntax.sigrng - uu___14); - ([], []))) in - let uu___9 = encode_elim () in - (match uu___9 with - | (decls2, elim) -> - let data_cons_typing_intro_decl - = - let uu___10 = - match t_res_tm.FStar_SMTEncoding_Term.tm - with - | FStar_SMTEncoding_Term.App - (op, args) -> - let uu___11 = - FStar_Compiler_List.splitAt - n_tps args in - (match uu___11 with - | (targs, iargs) -> - let uu___12 = - let uu___13 = - FStar_Compiler_List.map - (fun - uu___14 - -> - FStar_SMTEncoding_Env.fresh_fvar + | uu___12 -> + ((let uu___14 = + let uu___15 = + let uu___16 = + FStar_Syntax_Print.lid_to_string + d in + let uu___17 = + FStar_Syntax_Print.term_to_string + head in + FStar_Compiler_Util.format2 + "Constructor %s builds an unexpected type %s\n" + uu___16 uu___17 in + (FStar_Errors_Codes.Warning_ConstructorBuildsUnexpectedType, + uu___15) in + FStar_Errors.log_issue + se.FStar_Syntax_Syntax.sigrng + uu___14); + ([], []))) in + let uu___9 = encode_elim () in + (match uu___9 with + | (decls2, elim) -> + let data_cons_typing_intro_decl + = + let uu___10 = + match t_res_tm.FStar_SMTEncoding_Term.tm + with + | FStar_SMTEncoding_Term.App + (op, args) -> + let uu___11 = + FStar_Compiler_List.splitAt + n_tps args in + (match uu___11 with + | (targs, iargs) -> + let uu___12 = + let uu___13 = + FStar_Compiler_List.map + (fun uu___14 + -> + FStar_SMTEncoding_Env.fresh_fvar env1.FStar_SMTEncoding_Env.current_module_name "i" FStar_SMTEncoding_Term.Term_sort) - iargs in - FStar_Compiler_List.split - uu___13 in - (match uu___12 - with - | (fresh_ivars, - fresh_iargs) - -> - let additional_guards + iargs in + FStar_Compiler_List.split + uu___13 in + (match uu___12 with + | (fresh_ivars, + fresh_iargs) -> + let additional_guards + = + let uu___13 = - let uu___13 - = - FStar_Compiler_List.map2 + FStar_Compiler_List.map2 (fun a -> fun fresh_a @@ -6202,15 +5964,14 @@ let (encode_datacon : fresh_a)) iargs fresh_iargs in - FStar_SMTEncoding_Util.mk_and_l - uu___13 in - let uu___13 - = - FStar_SMTEncoding_Term.mk_HasTypeWithFuel - (FStar_Pervasives_Native.Some + FStar_SMTEncoding_Util.mk_and_l + uu___13 in + let uu___13 = + FStar_SMTEncoding_Term.mk_HasTypeWithFuel + (FStar_Pervasives_Native.Some fuel_tm) - dapp - { + dapp + { FStar_SMTEncoding_Term.tm = (FStar_SMTEncoding_Term.App @@ -6224,115 +5985,109 @@ let (encode_datacon : FStar_SMTEncoding_Term.rng = (t_res_tm.FStar_SMTEncoding_Term.rng) - } in - let uu___14 + } in + let uu___14 = + let uu___15 = - let uu___15 - = - FStar_Compiler_List.map + FStar_Compiler_List.map (fun s -> FStar_SMTEncoding_Term.mk_fv (s, FStar_SMTEncoding_Term.Term_sort)) fresh_ivars in - FStar_Compiler_List.op_At - vars - uu___15 in - let uu___15 - = - FStar_SMTEncoding_Util.mkAnd - (guard, + FStar_Compiler_List.op_At + vars + uu___15 in + let uu___15 = + FStar_SMTEncoding_Util.mkAnd + (guard, additional_guards) in - (uu___13, - uu___14, - uu___15))) - | uu___11 -> - (ty_pred', vars, - guard) in - match uu___10 with - | (ty_pred'1, vars1, guard1) - -> - let uu___11 = - let uu___12 = - let uu___13 = - FStar_Ident.range_of_lid - d in - let uu___14 = - let uu___15 = - let uu___16 = - FStar_SMTEncoding_Term.mk_fv - (fuel_var, - FStar_SMTEncoding_Term.Fuel_sort) in - FStar_SMTEncoding_Env.add_fuel - uu___16 vars1 in - let uu___16 = - FStar_SMTEncoding_Util.mkImp - (guard1, - ty_pred'1) in - ([[ty_pred'1]], - uu___15, - uu___16) in - FStar_SMTEncoding_Term.mkForall - uu___13 uu___14 in - (uu___12, - (FStar_Pervasives_Native.Some - "data constructor typing intro"), - (Prims.strcat - "data_typing_intro_" - ddtok)) in - FStar_SMTEncoding_Util.mkAssume - uu___11 in - let g = - let uu___10 = + (uu___13, + uu___14, + uu___15))) + | uu___11 -> + (ty_pred', vars, guard) in + match uu___10 with + | (ty_pred'1, vars1, guard1) + -> let uu___11 = let uu___12 = let uu___13 = - let uu___14 = - let uu___15 = - let uu___16 = - let uu___17 = - let uu___18 + FStar_Ident.range_of_lid + d in + let uu___14 = + let uu___15 = + let uu___16 = + FStar_SMTEncoding_Term.mk_fv + (fuel_var, + FStar_SMTEncoding_Term.Fuel_sort) in + FStar_SMTEncoding_Env.add_fuel + uu___16 vars1 in + let uu___16 = + FStar_SMTEncoding_Util.mkImp + (guard1, + ty_pred'1) in + ([[ty_pred'1]], + uu___15, uu___16) in + FStar_SMTEncoding_Term.mkForall + uu___13 uu___14 in + (uu___12, + (FStar_Pervasives_Native.Some + "data constructor typing intro"), + (Prims.strcat + "data_typing_intro_" + ddtok)) in + FStar_SMTEncoding_Util.mkAssume + uu___11 in + let g = + let uu___10 = + let uu___11 = + let uu___12 = + let uu___13 = + let uu___14 = + let uu___15 = + let uu___16 = + let uu___17 = + let uu___18 = + let uu___19 = - let uu___19 - = - let uu___20 + let uu___20 = FStar_Syntax_Print.lid_to_string d in - FStar_Compiler_Util.format1 + FStar_Compiler_Util.format1 "data constructor proxy: %s" uu___20 in - FStar_Pervasives_Native.Some - uu___19 in - (ddtok, [], - FStar_SMTEncoding_Term.Term_sort, - uu___18) in - FStar_SMTEncoding_Term.DeclFun - uu___17 in - [uu___16] in - FStar_Compiler_List.op_At - uu___15 - proxy_fresh in - FStar_SMTEncoding_Term.mk_decls_trivial - uu___14 in - let uu___14 = - let uu___15 = - let uu___16 = - let uu___17 = - let uu___18 = - FStar_SMTEncoding_Util.mkAssume - (tok_typing1, - (FStar_Pervasives_Native.Some + FStar_Pervasives_Native.Some + uu___19 in + (ddtok, [], + FStar_SMTEncoding_Term.Term_sort, + uu___18) in + FStar_SMTEncoding_Term.DeclFun + uu___17 in + [uu___16] in + FStar_Compiler_List.op_At + uu___15 + proxy_fresh in + FStar_SMTEncoding_Term.mk_decls_trivial + uu___14 in + let uu___14 = + let uu___15 = + let uu___16 = + let uu___17 = + let uu___18 = + FStar_SMTEncoding_Util.mkAssume + (tok_typing1, + (FStar_Pervasives_Native.Some "typing for data constructor proxy"), - (Prims.strcat + (Prims.strcat "typing_tok_" ddtok)) in - let uu___19 = - let uu___20 + let uu___19 = + let uu___20 = + let uu___21 = - let uu___21 - = - let uu___22 + let uu___22 = let uu___23 = @@ -6351,39 +6106,39 @@ let (encode_datacon : FStar_SMTEncoding_Term.mkForall uu___23 uu___24 in - (uu___22, + (uu___22, (FStar_Pervasives_Native.Some "equality for proxy"), (Prims.strcat "equality_tok_" ddtok)) in - FStar_SMTEncoding_Util.mkAssume - uu___21 in - [uu___20; - data_cons_typing_intro_decl] in - uu___18 :: - uu___19 in - FStar_Compiler_List.op_At - uu___17 elim in - FStar_SMTEncoding_Term.mk_decls_trivial - uu___16 in - FStar_Compiler_List.op_At - decls_pred uu___15 in + FStar_SMTEncoding_Util.mkAssume + uu___21 in + [uu___20; + data_cons_typing_intro_decl] in + uu___18 :: + uu___19 in + FStar_Compiler_List.op_At + uu___17 elim in + FStar_SMTEncoding_Term.mk_decls_trivial + uu___16 in FStar_Compiler_List.op_At - uu___13 uu___14 in + decls_pred uu___15 in FStar_Compiler_List.op_At - decls3 uu___12 in + uu___13 uu___14 in FStar_Compiler_List.op_At - decls2 uu___11 in - FStar_Compiler_List.op_At - binder_decls uu___10 in - let uu___10 = - let uu___11 = - FStar_SMTEncoding_Term.mk_decls_trivial - datacons in + decls3 uu___12 in FStar_Compiler_List.op_At - uu___11 g in - (uu___10, env1)))))))) + decls2 uu___11 in + FStar_Compiler_List.op_At + binder_decls uu___10 in + let uu___10 = + let uu___11 = + FStar_SMTEncoding_Term.mk_decls_trivial + datacons in + FStar_Compiler_List.op_At + uu___11 g in + (uu___10, env1)))))))) let rec (encode_sigelt : FStar_SMTEncoding_Env.env_t -> FStar_Syntax_Syntax.sigelt -> @@ -7013,16 +6768,6 @@ and (encode_sigelt' : { FStar_Syntax_Syntax.ses = ses; FStar_Syntax_Syntax.lids = uu___1;_} -> - let tycon = - FStar_Compiler_List.tryFind - (fun se1 -> - FStar_Syntax_Syntax.uu___is_Sig_inductive_typ - se1.FStar_Syntax_Syntax.sigel) ses in - let is_injective_on_params = - match tycon with - | FStar_Pervasives_Native.None -> false - | FStar_Pervasives_Native.Some se1 -> - is_sig_inductive_injective_on_params env se1 in let uu___2 = FStar_Compiler_List.fold_left (fun uu___3 -> @@ -7032,10 +6777,9 @@ and (encode_sigelt' : let uu___4 = match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_inductive_typ uu___5 -> - encode_sig_inductive is_injective_on_params - env1 se1 + encode_sig_inductive env1 se1 | FStar_Syntax_Syntax.Sig_datacon uu___5 -> - encode_datacon is_injective_on_params env1 se1 + encode_datacon env1 se1 | uu___5 -> encode_sigelt env1 se1 in (match uu___4 with | (g', env2) -> diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml b/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml index 06ff38992f3..22c03ce5d67 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml @@ -1179,16 +1179,17 @@ let (fv_qual_of_se : { FStar_Syntax_Syntax.lid1 = uu___; FStar_Syntax_Syntax.us1 = uu___1; FStar_Syntax_Syntax.t1 = uu___2; FStar_Syntax_Syntax.ty_lid = l; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_} + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> let qopt = FStar_Compiler_Util.find_map se.FStar_Syntax_Syntax.sigquals - (fun uu___5 -> - match uu___5 with - | FStar_Syntax_Syntax.RecordConstructor (uu___6, fs) -> + (fun uu___6 -> + match uu___6 with + | FStar_Syntax_Syntax.RecordConstructor (uu___7, fs) -> FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor (l, fs)) - | uu___6 -> FStar_Pervasives_Native.None) in + | uu___7 -> FStar_Pervasives_Native.None) in (match qopt with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor @@ -1949,14 +1950,15 @@ let (find_all_datacons : FStar_Syntax_Syntax.num_uniform_params = uu___4; FStar_Syntax_Syntax.t = uu___5; FStar_Syntax_Syntax.mutuals = datas; - FStar_Syntax_Syntax.ds = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_}, - uu___13) -> FStar_Pervasives_Native.Some datas + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_}, + uu___14) -> FStar_Pervasives_Native.Some datas | uu___1 -> FStar_Pervasives_Native.None in resolve_in_open_namespaces' env1 lid (fun uu___ -> FStar_Pervasives_Native.None) @@ -2066,13 +2068,15 @@ let (extract_record : FStar_Syntax_Syntax.t1 = uu___3; FStar_Syntax_Syntax.ty_lid = uu___4; FStar_Syntax_Syntax.num_ty_params = uu___5; - FStar_Syntax_Syntax.mutuals1 = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_} -> + FStar_Syntax_Syntax.mutuals1 = uu___6; + FStar_Syntax_Syntax.injective_type_params1 = + uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_} -> FStar_Ident.lid_equals dc lid | uu___2 -> false) sigs in FStar_Compiler_List.iter @@ -2087,51 +2091,54 @@ let (extract_record : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = uu___3; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = dc::[];_}; - FStar_Syntax_Syntax.sigrng = uu___5; + FStar_Syntax_Syntax.ds = dc::[]; + FStar_Syntax_Syntax.injective_type_params = uu___5;_}; + FStar_Syntax_Syntax.sigrng = uu___6; FStar_Syntax_Syntax.sigquals = typename_quals; - FStar_Syntax_Syntax.sigmeta = uu___6; - FStar_Syntax_Syntax.sigattrs = uu___7; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___8; - FStar_Syntax_Syntax.sigopts = uu___9;_} -> - let uu___10 = - let uu___11 = find_dc dc in - FStar_Compiler_Util.must uu___11 in - (match uu___10 with + FStar_Syntax_Syntax.sigmeta = uu___7; + FStar_Syntax_Syntax.sigattrs = uu___8; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; + FStar_Syntax_Syntax.sigopts = uu___10;_} -> + let uu___11 = + let uu___12 = find_dc dc in + FStar_Compiler_Util.must uu___12 in + (match uu___11 with | { FStar_Syntax_Syntax.sigel = FStar_Syntax_Syntax.Sig_datacon { FStar_Syntax_Syntax.lid1 = constrname; - FStar_Syntax_Syntax.us1 = uu___11; + FStar_Syntax_Syntax.us1 = uu___12; FStar_Syntax_Syntax.t1 = t; - FStar_Syntax_Syntax.ty_lid = uu___12; + FStar_Syntax_Syntax.ty_lid = uu___13; FStar_Syntax_Syntax.num_ty_params = n; - FStar_Syntax_Syntax.mutuals1 = uu___13;_}; - FStar_Syntax_Syntax.sigrng = uu___14; - FStar_Syntax_Syntax.sigquals = uu___15; - FStar_Syntax_Syntax.sigmeta = uu___16; - FStar_Syntax_Syntax.sigattrs = uu___17; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___18; - FStar_Syntax_Syntax.sigopts = uu___19;_} -> - let uu___20 = FStar_Syntax_Util.arrow_formals t in - (match uu___20 with - | (all_formals, uu___21) -> - let uu___22 = + FStar_Syntax_Syntax.mutuals1 = uu___14; + FStar_Syntax_Syntax.injective_type_params1 = + uu___15;_}; + FStar_Syntax_Syntax.sigrng = uu___16; + FStar_Syntax_Syntax.sigquals = uu___17; + FStar_Syntax_Syntax.sigmeta = uu___18; + FStar_Syntax_Syntax.sigattrs = uu___19; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___20; + FStar_Syntax_Syntax.sigopts = uu___21;_} -> + let uu___22 = FStar_Syntax_Util.arrow_formals t in + (match uu___22 with + | (all_formals, uu___23) -> + let uu___24 = FStar_Compiler_Util.first_N n all_formals in - (match uu___22 with + (match uu___24 with | (_params, formals) -> let is_rec = is_record typename_quals in let formals' = FStar_Compiler_List.collect (fun f -> - let uu___23 = + let uu___25 = (FStar_Syntax_Syntax.is_null_bv f.FStar_Syntax_Syntax.binder_bv) || (is_rec && (FStar_Syntax_Syntax.is_bqual_implicit f.FStar_Syntax_Syntax.binder_qual)) in - if uu___23 then [] else [f]) + if uu___25 then [] else [f]) formals in let fields' = FStar_Compiler_List.map @@ -2141,11 +2148,11 @@ let (extract_record : formals' in let fields = fields' in let record = - let uu___23 = + let uu___25 = FStar_Ident.ident_of_lid constrname in { typename; - constrname = uu___23; + constrname = uu___25; parms; fields; is_private = @@ -2154,41 +2161,41 @@ let (extract_record : typename_quals); is_record = is_rec } in - ((let uu___24 = - let uu___25 = + ((let uu___26 = + let uu___27 = FStar_Compiler_Effect.op_Bang new_globs in - (Record_or_dc record) :: uu___25 in + (Record_or_dc record) :: uu___27 in FStar_Compiler_Effect.op_Colon_Equals - new_globs uu___24); + new_globs uu___26); (match () with | () -> - ((let add_field uu___25 = - match uu___25 with - | (id, uu___26) -> + ((let add_field uu___27 = + match uu___27 with + | (id, uu___28) -> let modul = - let uu___27 = - let uu___28 = + let uu___29 = + let uu___30 = FStar_Ident.ns_of_lid constrname in FStar_Ident.lid_of_ids - uu___28 in + uu___30 in FStar_Ident.string_of_lid - uu___27 in - let uu___27 = + uu___29 in + let uu___29 = get_exported_id_set e modul in - (match uu___27 with + (match uu___29 with | FStar_Pervasives_Native.Some my_ex -> let my_exported_ids = my_ex Exported_id_field in - ((let uu___29 = - let uu___30 = + ((let uu___31 = + let uu___32 = FStar_Ident.string_of_id id in - let uu___31 = + let uu___33 = FStar_Compiler_Effect.op_Bang my_exported_ids in Obj.magic @@ -2197,27 +2204,27 @@ let (extract_record : (Obj.magic (FStar_Compiler_RBSet.setlike_rbset FStar_Class_Ord.ord_string)) - uu___30 + uu___32 (Obj.magic - uu___31)) in + uu___33)) in FStar_Compiler_Effect.op_Colon_Equals my_exported_ids - uu___29); + uu___31); (match () with | () -> let projname = - let uu___29 = - let uu___30 + let uu___31 = + let uu___32 = FStar_Syntax_Util.mk_field_projector_name_from_ident constrname id in FStar_Ident.ident_of_lid - uu___30 in + uu___32 in FStar_Ident.string_of_id - uu___29 in - let uu___30 = - let uu___31 = + uu___31 in + let uu___32 = + let uu___33 = FStar_Compiler_Effect.op_Bang my_exported_ids in Obj.magic @@ -2230,10 +2237,10 @@ let (extract_record : projname ( Obj.magic - uu___31)) in + uu___33)) in FStar_Compiler_Effect.op_Colon_Equals my_exported_ids - uu___30)) + uu___32)) | FStar_Pervasives_Native.None -> ()) in FStar_Compiler_List.iter @@ -2241,7 +2248,7 @@ let (extract_record : (match () with | () -> insert_record_cache record)))))) - | uu___11 -> ()) + | uu___12 -> ()) | uu___2 -> ()) sigs | uu___ -> () let (try_lookup_record_or_dc_by_field_name : @@ -2947,11 +2954,13 @@ let (finish : env -> FStar_Syntax_Syntax.modul -> env) = FStar_Syntax_Syntax.t1 = uu___3; FStar_Syntax_Syntax.ty_lid = uu___4; FStar_Syntax_Syntax.num_ty_params = uu___5; - FStar_Syntax_Syntax.mutuals1 = uu___6;_} + FStar_Syntax_Syntax.mutuals1 = uu___6; + FStar_Syntax_Syntax.injective_type_params1 = + uu___7;_} -> - let uu___7 = FStar_Ident.string_of_lid lid in + let uu___8 = FStar_Ident.string_of_lid lid in FStar_Compiler_Util.smap_remove (sigmap env1) - uu___7 + uu___8 | FStar_Syntax_Syntax.Sig_inductive_typ { FStar_Syntax_Syntax.lid = lid; FStar_Syntax_Syntax.us = univ_names; @@ -2959,36 +2968,39 @@ let (finish : env -> FStar_Syntax_Syntax.modul -> env) = FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = typ; FStar_Syntax_Syntax.mutuals = uu___3; - FStar_Syntax_Syntax.ds = uu___4;_} + FStar_Syntax_Syntax.ds = uu___4; + FStar_Syntax_Syntax.injective_type_params = + uu___5;_} -> - ((let uu___6 = FStar_Ident.string_of_lid lid in + ((let uu___7 = FStar_Ident.string_of_lid lid in FStar_Compiler_Util.smap_remove (sigmap env1) - uu___6); + uu___7); if Prims.op_Negation (FStar_Compiler_List.contains FStar_Syntax_Syntax.Private quals) then (let sigel = - let uu___6 = - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = + let uu___7 = + let uu___8 = + let uu___9 = + let uu___10 = + let uu___11 = FStar_Syntax_Syntax.mk_Total typ in { FStar_Syntax_Syntax.bs1 = binders; - FStar_Syntax_Syntax.comp = uu___10 + FStar_Syntax_Syntax.comp = uu___11 } in - FStar_Syntax_Syntax.Tm_arrow uu___9 in - let uu___9 = FStar_Ident.range_of_lid lid in - FStar_Syntax_Syntax.mk uu___8 uu___9 in + FStar_Syntax_Syntax.Tm_arrow uu___10 in + let uu___10 = + FStar_Ident.range_of_lid lid in + FStar_Syntax_Syntax.mk uu___9 uu___10 in { FStar_Syntax_Syntax.lid2 = lid; FStar_Syntax_Syntax.us2 = univ_names; - FStar_Syntax_Syntax.t2 = uu___7 + FStar_Syntax_Syntax.t2 = uu___8 } in - FStar_Syntax_Syntax.Sig_declare_typ uu___6 in + FStar_Syntax_Syntax.Sig_declare_typ uu___7 in let se2 = { FStar_Syntax_Syntax.sigel = sigel; @@ -3005,9 +3017,9 @@ let (finish : env -> FStar_Syntax_Syntax.modul -> env) = FStar_Syntax_Syntax.sigopts = (se1.FStar_Syntax_Syntax.sigopts) } in - let uu___6 = FStar_Ident.string_of_lid lid in + let uu___7 = FStar_Ident.string_of_lid lid in FStar_Compiler_Util.smap_add (sigmap env1) - uu___6 (se2, false)) + uu___7 (se2, false)) else ()) | uu___2 -> ()) ses else () diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_MutRecTy.ml b/ocaml/fstar-lib/generated/FStar_Syntax_MutRecTy.ml index 4d998fe1010..5523021bbb0 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_MutRecTy.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_MutRecTy.ml @@ -353,7 +353,9 @@ let (disentangle_abbrevs_from_bundle : FStar_Syntax_Syntax.num_uniform_params = num_uniform; FStar_Syntax_Syntax.t = ty; FStar_Syntax_Syntax.mutuals = mut; - FStar_Syntax_Syntax.ds = dc;_} + FStar_Syntax_Syntax.ds = dc; + FStar_Syntax_Syntax.injective_type_params = + injective_type_params;_} -> let bnd' = FStar_Syntax_InstFV.inst_binders unfold_fv bnd in @@ -370,7 +372,9 @@ let (disentangle_abbrevs_from_bundle : num_uniform; FStar_Syntax_Syntax.t = ty'; FStar_Syntax_Syntax.mutuals = mut'; - FStar_Syntax_Syntax.ds = dc + FStar_Syntax_Syntax.ds = dc; + FStar_Syntax_Syntax.injective_type_params = + injective_type_params }); FStar_Syntax_Syntax.sigrng = (x.FStar_Syntax_Syntax.sigrng); @@ -391,7 +395,9 @@ let (disentangle_abbrevs_from_bundle : FStar_Syntax_Syntax.t1 = ty; FStar_Syntax_Syntax.ty_lid = res; FStar_Syntax_Syntax.num_ty_params = npars; - FStar_Syntax_Syntax.mutuals1 = mut;_} + FStar_Syntax_Syntax.mutuals1 = mut; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params;_} -> let ty' = FStar_Syntax_InstFV.inst unfold_fv ty in let mut' = filter_out_type_abbrevs mut in @@ -404,7 +410,9 @@ let (disentangle_abbrevs_from_bundle : FStar_Syntax_Syntax.t1 = ty'; FStar_Syntax_Syntax.ty_lid = res; FStar_Syntax_Syntax.num_ty_params = npars; - FStar_Syntax_Syntax.mutuals1 = mut' + FStar_Syntax_Syntax.mutuals1 = mut'; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params }); FStar_Syntax_Syntax.sigrng = (x.FStar_Syntax_Syntax.sigrng); diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml index 930a25fe49b..c24e8bb91ef 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml @@ -1450,41 +1450,43 @@ let rec (sigelt_to_string : FStar_Syntax_Syntax.sigelt -> Prims.string) = FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___3; - FStar_Syntax_Syntax.ds = uu___4;_} + FStar_Syntax_Syntax.ds = uu___4; + FStar_Syntax_Syntax.injective_type_params = uu___5;_} -> let quals_str = quals_to_string' x.FStar_Syntax_Syntax.sigquals in let binders_str = binders_to_string " " tps in let term_str = term_to_string k in - let uu___5 = FStar_Options.print_universes () in - if uu___5 + let uu___6 = FStar_Options.print_universes () in + if uu___6 then - let uu___6 = FStar_Ident.string_of_lid lid in - let uu___7 = univ_names_to_string univs in + let uu___7 = FStar_Ident.string_of_lid lid in + let uu___8 = univ_names_to_string univs in FStar_Compiler_Util.format5 "%stype %s<%s> %s : %s" quals_str - uu___6 uu___7 binders_str term_str + uu___7 uu___8 binders_str term_str else - (let uu___7 = FStar_Ident.string_of_lid lid in + (let uu___8 = FStar_Ident.string_of_lid lid in FStar_Compiler_Util.format4 "%stype %s %s : %s" quals_str - uu___7 binders_str term_str) + uu___8 binders_str term_str) | FStar_Syntax_Syntax.Sig_datacon { FStar_Syntax_Syntax.lid1 = lid; FStar_Syntax_Syntax.us1 = univs; FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_} + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> - let uu___5 = FStar_Options.print_universes () in - if uu___5 + let uu___6 = FStar_Options.print_universes () in + if uu___6 then - let uu___6 = univ_names_to_string univs in - let uu___7 = FStar_Ident.string_of_lid lid in - let uu___8 = term_to_string t in - FStar_Compiler_Util.format3 "datacon<%s> %s : %s" uu___6 - uu___7 uu___8 + let uu___7 = univ_names_to_string univs in + let uu___8 = FStar_Ident.string_of_lid lid in + let uu___9 = term_to_string t in + FStar_Compiler_Util.format3 "datacon<%s> %s : %s" uu___7 + uu___8 uu___9 else - (let uu___7 = FStar_Ident.string_of_lid lid in - let uu___8 = term_to_string t in - FStar_Compiler_Util.format2 "datacon %s : %s" uu___7 uu___8) + (let uu___8 = FStar_Ident.string_of_lid lid in + let uu___9 = term_to_string t in + FStar_Compiler_Util.format2 "datacon %s : %s" uu___8 uu___9) | FStar_Syntax_Syntax.Sig_declare_typ { FStar_Syntax_Syntax.lid2 = lid; FStar_Syntax_Syntax.us2 = univs; FStar_Syntax_Syntax.t2 = t;_} @@ -1726,20 +1728,22 @@ let rec (sigelt_to_string_short : FStar_Syntax_Syntax.sigelt -> Prims.string) FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = uu___3; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> - let uu___6 = FStar_Ident.string_of_lid lid in - FStar_Compiler_Util.format1 "type %s" uu___6 + let uu___7 = FStar_Ident.string_of_lid lid in + FStar_Compiler_Util.format1 "type %s" uu___7 | FStar_Syntax_Syntax.Sig_datacon { FStar_Syntax_Syntax.lid1 = lid; FStar_Syntax_Syntax.us1 = uu___; FStar_Syntax_Syntax.t1 = uu___1; FStar_Syntax_Syntax.ty_lid = t_lid; FStar_Syntax_Syntax.num_ty_params = uu___2; - FStar_Syntax_Syntax.mutuals1 = uu___3;_} + FStar_Syntax_Syntax.mutuals1 = uu___3; + FStar_Syntax_Syntax.injective_type_params1 = uu___4;_} -> - let uu___4 = FStar_Ident.string_of_lid lid in - let uu___5 = FStar_Ident.string_of_lid t_lid in - FStar_Compiler_Util.format2 "datacon %s for type %s" uu___4 uu___5 + let uu___5 = FStar_Ident.string_of_lid lid in + let uu___6 = FStar_Ident.string_of_lid t_lid in + FStar_Compiler_Util.format2 "datacon %s for type %s" uu___5 uu___6 | FStar_Syntax_Syntax.Sig_assume { FStar_Syntax_Syntax.lid3 = lid; FStar_Syntax_Syntax.us3 = uu___; FStar_Syntax_Syntax.phi1 = uu___1;_} diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml index d9ea812baef..805022a39c1 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml @@ -2379,96 +2379,100 @@ let (resugar_typ : FStar_Syntax_Syntax.num_uniform_params = uu___; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = uu___1; - FStar_Syntax_Syntax.ds = datacons;_} + FStar_Syntax_Syntax.ds = datacons; + FStar_Syntax_Syntax.injective_type_params = uu___2;_} -> - let uu___2 = + let uu___3 = FStar_Compiler_List.partition (fun se1 -> match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_datacon - { FStar_Syntax_Syntax.lid1 = uu___3; - FStar_Syntax_Syntax.us1 = uu___4; - FStar_Syntax_Syntax.t1 = uu___5; + { FStar_Syntax_Syntax.lid1 = uu___4; + FStar_Syntax_Syntax.us1 = uu___5; + FStar_Syntax_Syntax.t1 = uu___6; FStar_Syntax_Syntax.ty_lid = inductive_lid; - FStar_Syntax_Syntax.num_ty_params = uu___6; - FStar_Syntax_Syntax.mutuals1 = uu___7;_} + FStar_Syntax_Syntax.num_ty_params = uu___7; + FStar_Syntax_Syntax.mutuals1 = uu___8; + FStar_Syntax_Syntax.injective_type_params1 = uu___9;_} -> FStar_Ident.lid_equals inductive_lid tylid - | uu___3 -> FStar_Compiler_Effect.failwith "unexpected") + | uu___4 -> FStar_Compiler_Effect.failwith "unexpected") datacon_ses in - (match uu___2 with + (match uu___3 with | (current_datacons, other_datacons) -> let bs1 = - let uu___3 = FStar_Options.print_implicits () in - if uu___3 then bs else filter_imp_bs bs in + let uu___4 = FStar_Options.print_implicits () in + if uu___4 then bs else filter_imp_bs bs in let bs2 = (map_opt ()) (fun b -> resugar_binder' env b t.FStar_Syntax_Syntax.pos) bs1 in let tyc = - let uu___3 = + let uu___4 = FStar_Compiler_Util.for_some - (fun uu___4 -> - match uu___4 with - | FStar_Syntax_Syntax.RecordType uu___5 -> true - | uu___5 -> false) se.FStar_Syntax_Syntax.sigquals in - if uu___3 + (fun uu___5 -> + match uu___5 with + | FStar_Syntax_Syntax.RecordType uu___6 -> true + | uu___6 -> false) se.FStar_Syntax_Syntax.sigquals in + if uu___4 then let resugar_datacon_as_fields fields se1 = match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_datacon - { FStar_Syntax_Syntax.lid1 = uu___4; + { FStar_Syntax_Syntax.lid1 = uu___5; FStar_Syntax_Syntax.us1 = univs; FStar_Syntax_Syntax.t1 = term; - FStar_Syntax_Syntax.ty_lid = uu___5; + FStar_Syntax_Syntax.ty_lid = uu___6; FStar_Syntax_Syntax.num_ty_params = num; - FStar_Syntax_Syntax.mutuals1 = uu___6;_} + FStar_Syntax_Syntax.mutuals1 = uu___7; + FStar_Syntax_Syntax.injective_type_params1 = + uu___8;_} -> - let uu___7 = - let uu___8 = FStar_Syntax_Subst.compress term in - uu___8.FStar_Syntax_Syntax.n in - (match uu___7 with + let uu___9 = + let uu___10 = FStar_Syntax_Subst.compress term in + uu___10.FStar_Syntax_Syntax.n in + (match uu___9 with | FStar_Syntax_Syntax.Tm_arrow { FStar_Syntax_Syntax.bs1 = bs3; - FStar_Syntax_Syntax.comp = uu___8;_} + FStar_Syntax_Syntax.comp = uu___10;_} -> let mfields = FStar_Compiler_List.collect (fun b -> - let uu___9 = + let uu___11 = resugar_bqual env b.FStar_Syntax_Syntax.binder_qual in - match uu___9 with + match uu___11 with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some q -> - let uu___10 = - let uu___11 = + let uu___12 = + let uu___13 = bv_as_unique_ident b.FStar_Syntax_Syntax.binder_bv in - let uu___12 = + let uu___14 = FStar_Compiler_List.map (resugar_term' env) b.FStar_Syntax_Syntax.binder_attrs in - let uu___13 = + let uu___15 = resugar_term' env (b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in - (uu___11, q, uu___12, uu___13) in - [uu___10]) bs3 in + (uu___13, q, uu___14, uu___15) in + [uu___12]) bs3 in FStar_Compiler_List.op_At mfields fields - | uu___8 -> + | uu___10 -> FStar_Compiler_Effect.failwith "unexpected") - | uu___4 -> + | uu___5 -> FStar_Compiler_Effect.failwith "unexpected" in let fields = FStar_Compiler_List.fold_left resugar_datacon_as_fields [] current_datacons in - let uu___4 = - let uu___5 = FStar_Ident.ident_of_lid tylid in - let uu___6 = + let uu___5 = + let uu___6 = FStar_Ident.ident_of_lid tylid in + let uu___7 = FStar_Compiler_List.map (resugar_term' env) se.FStar_Syntax_Syntax.sigattrs in - (uu___5, bs2, FStar_Pervasives_Native.None, uu___6, + (uu___6, bs2, FStar_Pervasives_Native.None, uu___7, fields) in - FStar_Parser_AST.TyconRecord uu___4 + FStar_Parser_AST.TyconRecord uu___5 else (let resugar_datacon constructors se1 = match se1.FStar_Syntax_Syntax.sigel with @@ -2476,32 +2480,34 @@ let (resugar_typ : { FStar_Syntax_Syntax.lid1 = l; FStar_Syntax_Syntax.us1 = univs; FStar_Syntax_Syntax.t1 = term; - FStar_Syntax_Syntax.ty_lid = uu___5; + FStar_Syntax_Syntax.ty_lid = uu___6; FStar_Syntax_Syntax.num_ty_params = num; - FStar_Syntax_Syntax.mutuals1 = uu___6;_} + FStar_Syntax_Syntax.mutuals1 = uu___7; + FStar_Syntax_Syntax.injective_type_params1 = + uu___8;_} -> let c = - let uu___7 = FStar_Ident.ident_of_lid l in - let uu___8 = - let uu___9 = - let uu___10 = resugar_term' env term in - FStar_Parser_AST.VpArbitrary uu___10 in - FStar_Pervasives_Native.Some uu___9 in - let uu___9 = + let uu___9 = FStar_Ident.ident_of_lid l in + let uu___10 = + let uu___11 = + let uu___12 = resugar_term' env term in + FStar_Parser_AST.VpArbitrary uu___12 in + FStar_Pervasives_Native.Some uu___11 in + let uu___11 = FStar_Compiler_List.map (resugar_term' env) se1.FStar_Syntax_Syntax.sigattrs in - (uu___7, uu___8, uu___9) in + (uu___9, uu___10, uu___11) in c :: constructors - | uu___5 -> + | uu___6 -> FStar_Compiler_Effect.failwith "unexpected" in let constructors = FStar_Compiler_List.fold_left resugar_datacon [] current_datacons in - let uu___5 = - let uu___6 = FStar_Ident.ident_of_lid tylid in - (uu___6, bs2, FStar_Pervasives_Native.None, + let uu___6 = + let uu___7 = FStar_Ident.ident_of_lid tylid in + (uu___7, bs2, FStar_Pervasives_Native.None, constructors) in - FStar_Parser_AST.TyconVariant uu___5) in + FStar_Parser_AST.TyconVariant uu___6) in (other_datacons, tyc)) | uu___ -> FStar_Compiler_Effect.failwith @@ -2819,16 +2825,18 @@ let (resugar_sigelt' : FStar_Syntax_Syntax.t1 = uu___4; FStar_Syntax_Syntax.ty_lid = uu___5; FStar_Syntax_Syntax.num_ty_params = uu___6; - FStar_Syntax_Syntax.mutuals1 = uu___7;_} + FStar_Syntax_Syntax.mutuals1 = uu___7; + FStar_Syntax_Syntax.injective_type_params1 = + uu___8;_} -> - let uu___8 = - let uu___9 = - let uu___10 = - let uu___11 = FStar_Ident.ident_of_lid l in - (uu___11, FStar_Pervasives_Native.None) in - FStar_Parser_AST.Exception uu___10 in - decl'_to_decl se1 uu___9 in - FStar_Pervasives_Native.Some uu___8 + let uu___9 = + let uu___10 = + let uu___11 = + let uu___12 = FStar_Ident.ident_of_lid l in + (uu___12, FStar_Pervasives_Native.None) in + FStar_Parser_AST.Exception uu___11 in + decl'_to_decl se1 uu___10 in + FStar_Pervasives_Native.Some uu___9 | uu___3 -> FStar_Compiler_Effect.failwith "wrong format for resguar to Exception") diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml index 35276ce22c0..2eb354d8cae 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml @@ -1772,7 +1772,8 @@ type sigelt'__Sig_inductive_typ__payload = num_uniform_params: Prims.int FStar_Pervasives_Native.option ; t: typ ; mutuals: FStar_Ident.lident Prims.list ; - ds: FStar_Ident.lident Prims.list } + ds: FStar_Ident.lident Prims.list ; + injective_type_params: Prims.bool } and sigelt'__Sig_bundle__payload = { ses: sigelt Prims.list ; @@ -1784,7 +1785,8 @@ and sigelt'__Sig_datacon__payload = t1: typ ; ty_lid: FStar_Ident.lident ; num_ty_params: Prims.int ; - mutuals1: FStar_Ident.lident Prims.list } + mutuals1: FStar_Ident.lident Prims.list ; + injective_type_params1: Prims.bool } and sigelt'__Sig_declare_typ__payload = { lid2: FStar_Ident.lident ; @@ -1862,17 +1864,20 @@ let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__lid : sigelt'__Sig_inductive_typ__payload -> FStar_Ident.lident) = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> lid + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> lid let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__us : sigelt'__Sig_inductive_typ__payload -> univ_names) = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> us + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> us let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__params : sigelt'__Sig_inductive_typ__payload -> binders) = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> params + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> params let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__num_uniform_params : sigelt'__Sig_inductive_typ__payload -> @@ -1880,23 +1885,32 @@ let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__num_uniform_params = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> - num_uniform_params + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> num_uniform_params let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__t : sigelt'__Sig_inductive_typ__payload -> typ) = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> t + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> t let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__mutuals : sigelt'__Sig_inductive_typ__payload -> FStar_Ident.lident Prims.list) = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> mutuals + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> mutuals let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__ds : sigelt'__Sig_inductive_typ__payload -> FStar_Ident.lident Prims.list) = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> ds + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> ds +let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__injective_type_params + : sigelt'__Sig_inductive_typ__payload -> Prims.bool) = + fun projectee -> + match projectee with + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> injective_type_params let (__proj__Mksigelt'__Sig_bundle__payload__item__ses : sigelt'__Sig_bundle__payload -> sigelt Prims.list) = fun projectee -> match projectee with | { ses; lids;_} -> ses @@ -1908,37 +1922,50 @@ let (__proj__Mksigelt'__Sig_datacon__payload__item__lid : fun projectee -> match projectee with | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; - mutuals1 = mutuals;_} -> lid + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> lid let (__proj__Mksigelt'__Sig_datacon__payload__item__us : sigelt'__Sig_datacon__payload -> univ_names) = fun projectee -> match projectee with | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; - mutuals1 = mutuals;_} -> us + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> us let (__proj__Mksigelt'__Sig_datacon__payload__item__t : sigelt'__Sig_datacon__payload -> typ) = fun projectee -> match projectee with | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; - mutuals1 = mutuals;_} -> t + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> t let (__proj__Mksigelt'__Sig_datacon__payload__item__ty_lid : sigelt'__Sig_datacon__payload -> FStar_Ident.lident) = fun projectee -> match projectee with | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; - mutuals1 = mutuals;_} -> ty_lid + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> ty_lid let (__proj__Mksigelt'__Sig_datacon__payload__item__num_ty_params : sigelt'__Sig_datacon__payload -> Prims.int) = fun projectee -> match projectee with | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; - mutuals1 = mutuals;_} -> num_ty_params + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> num_ty_params let (__proj__Mksigelt'__Sig_datacon__payload__item__mutuals : sigelt'__Sig_datacon__payload -> FStar_Ident.lident Prims.list) = fun projectee -> match projectee with | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; - mutuals1 = mutuals;_} -> mutuals + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> mutuals +let (__proj__Mksigelt'__Sig_datacon__payload__item__injective_type_params : + sigelt'__Sig_datacon__payload -> Prims.bool) = + fun projectee -> + match projectee with + | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> injective_type_params let (__proj__Mksigelt'__Sig_declare_typ__payload__item__lid : sigelt'__Sig_declare_typ__payload -> FStar_Ident.lident) = fun projectee -> diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml index 20334fc76d1..9c14f74f34c 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml @@ -1065,7 +1065,8 @@ let (lids_of_sigelt : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = uu___3; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> [lid] | FStar_Syntax_Syntax.Sig_effect_abbrev { FStar_Syntax_Syntax.lid4 = lid; FStar_Syntax_Syntax.us4 = uu___; @@ -1078,7 +1079,8 @@ let (lids_of_sigelt : FStar_Syntax_Syntax.t1 = uu___1; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_} + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> [lid] | FStar_Syntax_Syntax.Sig_declare_typ { FStar_Syntax_Syntax.lid2 = lid; FStar_Syntax_Syntax.us2 = uu___; diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_VisitM.ml b/ocaml/fstar-lib/generated/FStar_Syntax_VisitM.ml index a51590443a2..b9e76115bd4 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_VisitM.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_VisitM.ml @@ -1652,7 +1652,8 @@ let rec on_sub_sigelt' : 'm . 'm lvm -> FStar_Syntax_Syntax.sigelt' -> 'm = FStar_Syntax_Syntax.params = params; FStar_Syntax_Syntax.num_uniform_params = num_uniform_params; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = mutuals; - FStar_Syntax_Syntax.ds = ds;_} + FStar_Syntax_Syntax.ds = ds; + FStar_Syntax_Syntax.injective_type_params = injective_type_params;_} -> let uu___ = FStar_Class_Monad.mapM (_lvm_monad d) () () @@ -1683,7 +1684,9 @@ let rec on_sub_sigelt' : 'm . 'm lvm -> FStar_Syntax_Syntax.sigelt' -> 'm = FStar_Syntax_Syntax.t = t1; FStar_Syntax_Syntax.mutuals = mutuals; - FStar_Syntax_Syntax.ds = ds + FStar_Syntax_Syntax.ds = ds; + FStar_Syntax_Syntax.injective_type_params + = injective_type_params })))) uu___2))) uu___1) | FStar_Syntax_Syntax.Sig_bundle { FStar_Syntax_Syntax.ses = ses; FStar_Syntax_Syntax.lids = lids;_} @@ -1708,7 +1711,9 @@ let rec on_sub_sigelt' : 'm . 'm lvm -> FStar_Syntax_Syntax.sigelt' -> 'm = { FStar_Syntax_Syntax.lid1 = lid; FStar_Syntax_Syntax.us1 = us; FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = ty_lid; FStar_Syntax_Syntax.num_ty_params = num_ty_params; - FStar_Syntax_Syntax.mutuals1 = mutuals;_} + FStar_Syntax_Syntax.mutuals1 = mutuals; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params;_} -> let uu___ = f_term d t in FStar_Class_Monad.op_let_Bang (_lvm_monad d) () () uu___ @@ -1726,7 +1731,9 @@ let rec on_sub_sigelt' : 'm . 'm lvm -> FStar_Syntax_Syntax.sigelt' -> 'm = FStar_Syntax_Syntax.ty_lid = ty_lid; FStar_Syntax_Syntax.num_ty_params = num_ty_params; - FStar_Syntax_Syntax.mutuals1 = mutuals + FStar_Syntax_Syntax.mutuals1 = mutuals; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params })))) uu___1) | FStar_Syntax_Syntax.Sig_declare_typ { FStar_Syntax_Syntax.lid2 = lid; FStar_Syntax_Syntax.us2 = us; diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml index b0786a86398..515138046e4 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml @@ -7423,7 +7423,9 @@ let (t_destruct : FStar_Syntax_Syntax.mutuals = mut; FStar_Syntax_Syntax.ds - = c_lids;_} + = c_lids; + FStar_Syntax_Syntax.injective_type_params + = uu___11;_} -> Obj.repr (let erasable @@ -7431,36 +7433,36 @@ let (t_destruct : FStar_Syntax_Util.has_attribute se.FStar_Syntax_Syntax.sigattrs FStar_Parser_Const.erasable_attr in - let uu___11 - = let uu___12 = + let uu___13 + = erasable && - (let uu___13 + (let uu___14 = is_irrelevant g in Prims.op_Negation - uu___13) in + uu___14) in failwhen - uu___12 + uu___13 "cannot destruct erasable type to solve proof-relevant goal" in FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___11 - (fun uu___12 + (fun + uu___13 -> (fun - uu___12 + uu___13 -> - let uu___12 + let uu___13 = Obj.magic - uu___12 in - let uu___13 + uu___13 in + let uu___14 = failwhen ((FStar_Compiler_List.length @@ -7472,34 +7474,34 @@ let (t_destruct : (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___13 - (fun uu___14 + (fun + uu___15 -> (fun - uu___14 + uu___15 -> - let uu___14 + let uu___15 = Obj.magic - uu___14 in - let uu___15 + uu___15 in + let uu___16 = FStar_Syntax_Subst.open_term t_ps t_ty in - match uu___15 + match uu___16 with | (t_ps1, t_ty1) -> - let uu___16 + let uu___17 = Obj.magic (FStar_Class_Monad.mapM FStar_Tactics_Monad.monad_tac () () (fun - uu___17 + uu___18 -> (fun c_lid -> @@ -7507,16 +7509,16 @@ let (t_destruct : = Obj.magic c_lid in - let uu___17 - = let uu___18 = + let uu___19 + = FStar_Tactics_Types.goal_env g in FStar_TypeChecker_Env.lookup_sigelt - uu___18 + uu___19 c_lid in - match uu___17 + match uu___18 with | FStar_Pervasives_Native.None @@ -7537,17 +7539,19 @@ let (t_destruct : FStar_Syntax_Syntax.Sig_datacon { FStar_Syntax_Syntax.lid1 - = uu___18; + = uu___19; FStar_Syntax_Syntax.us1 = c_us; FStar_Syntax_Syntax.t1 = c_ty; FStar_Syntax_Syntax.ty_lid - = uu___19; + = uu___20; FStar_Syntax_Syntax.num_ty_params = nparam; FStar_Syntax_Syntax.mutuals1 - = mut1;_} + = mut1; + FStar_Syntax_Syntax.injective_type_params1 + = uu___21;_} -> Obj.repr (let fv1 @@ -7556,7 +7560,7 @@ let (t_destruct : c_lid (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor) in - let uu___20 + let uu___22 = failwhen ((FStar_Compiler_List.length @@ -7567,17 +7571,17 @@ let (t_destruct : FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___20 + uu___22 (fun - uu___21 + uu___23 -> (fun - uu___21 + uu___23 -> - let uu___21 + let uu___23 = Obj.magic - uu___21 in + uu___23 in let s = FStar_TypeChecker_Env.mk_univ_subst c_us a_us in @@ -7585,26 +7589,26 @@ let (t_destruct : = FStar_Syntax_Subst.subst s c_ty in - let uu___22 + let uu___24 = FStar_TypeChecker_Env.inst_tscheme (c_us, c_ty1) in - match uu___22 + match uu___24 with | (c_us1, c_ty2) -> - let uu___23 + let uu___25 = FStar_Syntax_Util.arrow_formals_comp c_ty2 in - (match uu___23 + (match uu___25 with | (bs, comp) -> - let uu___24 + let uu___26 = let rename_bv bv = @@ -7613,26 +7617,26 @@ let (t_destruct : bv.FStar_Syntax_Syntax.ppname in let ppname1 = - let uu___25 + let uu___27 = - let uu___26 + let uu___28 = - let uu___27 + let uu___29 = FStar_Class_Show.show FStar_Ident.showable_ident ppname in Prims.strcat "a" - uu___27 in - let uu___27 + uu___29 in + let uu___29 = FStar_Ident.range_of_id ppname in - (uu___26, - uu___27) in + (uu___28, + uu___29) in FStar_Ident.mk_ident - uu___25 in + uu___27 in FStar_Syntax_Syntax.freshen_bv { FStar_Syntax_Syntax.ppname @@ -7647,13 +7651,13 @@ let (t_destruct : let bs' = FStar_Compiler_List.map (fun b -> - let uu___25 + let uu___27 = rename_bv b.FStar_Syntax_Syntax.binder_bv in { FStar_Syntax_Syntax.binder_bv - = uu___25; + = uu___27; FStar_Syntax_Syntax.binder_qual = (b.FStar_Syntax_Syntax.binder_qual); @@ -7668,100 +7672,100 @@ let (t_destruct : = FStar_Compiler_List.map2 (fun - uu___25 + uu___27 -> fun - uu___26 + uu___28 -> match - (uu___25, - uu___26) + (uu___27, + uu___28) with | ({ FStar_Syntax_Syntax.binder_bv = bv; FStar_Syntax_Syntax.binder_qual - = uu___27; + = uu___29; FStar_Syntax_Syntax.binder_positivity - = uu___28; + = uu___30; FStar_Syntax_Syntax.binder_attrs - = uu___29;_}, + = uu___31;_}, { FStar_Syntax_Syntax.binder_bv = bv'; FStar_Syntax_Syntax.binder_qual - = uu___30; + = uu___32; FStar_Syntax_Syntax.binder_positivity - = uu___31; + = uu___33; FStar_Syntax_Syntax.binder_attrs - = uu___32;_}) + = uu___34;_}) -> - let uu___33 + let uu___35 = - let uu___34 + let uu___36 = FStar_Syntax_Syntax.bv_to_name bv' in (bv, - uu___34) in + uu___36) in FStar_Syntax_Syntax.NT - uu___33) + uu___35) bs bs' in - let uu___25 + let uu___27 = FStar_Syntax_Subst.subst_binders subst bs' in - let uu___26 + let uu___28 = FStar_Syntax_Subst.subst_comp subst comp in - (uu___25, - uu___26) in - (match uu___24 + (uu___27, + uu___28) in + (match uu___26 with | (bs1, comp1) -> - let uu___25 + let uu___27 = FStar_Compiler_List.splitAt nparam bs1 in - (match uu___25 + (match uu___27 with | (d_ps, bs2) -> - let uu___26 + let uu___28 = - let uu___27 + let uu___29 = - let uu___28 + let uu___30 = FStar_Syntax_Util.is_total_comp comp1 in Prims.op_Negation - uu___28 in + uu___30 in failwhen - uu___27 + uu___29 "not total?" in Obj.magic (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___26 + uu___28 (fun - uu___27 + uu___29 -> (fun - uu___27 + uu___29 -> - let uu___27 + let uu___29 = Obj.magic - uu___27 in + uu___29 in let mk_pat p = { @@ -7772,28 +7776,28 @@ let (t_destruct : (s_tm1.FStar_Syntax_Syntax.pos) } in let is_imp - uu___28 = - match uu___28 + uu___30 = + match uu___30 with | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit - uu___29) + uu___31) -> true | - uu___29 + uu___31 -> false in - let uu___28 + let uu___30 = FStar_Compiler_List.splitAt nparam args in - match uu___28 + match uu___30 with | (a_ps, a_is) -> - let uu___29 + let uu___31 = failwhen ((FStar_Compiler_List.length @@ -7805,17 +7809,17 @@ let (t_destruct : (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___29 + uu___31 (fun - uu___30 + uu___32 -> (fun - uu___30 + uu___32 -> - let uu___30 + let uu___32 = Obj.magic - uu___30 in + uu___32 in let d_ps_a_ps = FStar_Compiler_List.zip @@ -7824,22 +7828,22 @@ let (t_destruct : = FStar_Compiler_List.map (fun - uu___31 + uu___33 -> - match uu___31 + match uu___33 with | ({ FStar_Syntax_Syntax.binder_bv = bv; FStar_Syntax_Syntax.binder_qual - = uu___32; + = uu___34; FStar_Syntax_Syntax.binder_positivity - = uu___33; + = uu___35; FStar_Syntax_Syntax.binder_attrs - = uu___34;_}, + = uu___36;_}, (t, - uu___35)) + uu___37)) -> FStar_Syntax_Syntax.NT (bv, t)) @@ -7851,22 +7855,22 @@ let (t_destruct : = FStar_Compiler_List.map (fun - uu___31 + uu___33 -> - match uu___31 + match uu___33 with | ({ FStar_Syntax_Syntax.binder_bv = bv; FStar_Syntax_Syntax.binder_qual - = uu___32; + = uu___34; FStar_Syntax_Syntax.binder_positivity - = uu___33; + = uu___35; FStar_Syntax_Syntax.binder_attrs - = uu___34;_}, + = uu___36;_}, (t, - uu___35)) + uu___37)) -> ((mk_pat (FStar_Syntax_Syntax.Pat_dot_term @@ -7878,9 +7882,9 @@ let (t_destruct : = FStar_Compiler_List.map (fun - uu___31 + uu___33 -> - match uu___31 + match uu___33 with | { @@ -7889,9 +7893,9 @@ let (t_destruct : FStar_Syntax_Syntax.binder_qual = bq; FStar_Syntax_Syntax.binder_positivity - = uu___32; + = uu___34; FStar_Syntax_Syntax.binder_attrs - = uu___33;_} + = uu___35;_} -> ((mk_pat (FStar_Syntax_Syntax.Pat_var @@ -7921,7 +7925,7 @@ let (t_destruct : env1.FStar_TypeChecker_Env.universe_of env1 s_ty1 in - let uu___31 + let uu___33 = FStar_TypeChecker_TcTerm.tc_pat { @@ -8082,23 +8086,23 @@ let (t_destruct : (env1.FStar_TypeChecker_Env.core_check) } s_ty1 pat in - match uu___31 + match uu___33 with | - (uu___32, - uu___33, - uu___34, + (uu___34, uu___35, - pat_t, uu___36, + uu___37, + pat_t, + uu___38, _guard_pat, _erasable) -> let eq_b = - let uu___37 + let uu___39 = - let uu___38 + let uu___40 = FStar_Syntax_Util.mk_eq2 equ s_ty1 @@ -8106,38 +8110,38 @@ let (t_destruct : pat_t in FStar_Syntax_Util.mk_squash FStar_Syntax_Syntax.U_zero - uu___38 in + uu___40 in FStar_Syntax_Syntax.gen_bv "breq" FStar_Pervasives_Native.None - uu___37 in + uu___39 in let cod1 = - let uu___37 + let uu___39 = - let uu___38 + let uu___40 = FStar_Syntax_Syntax.mk_binder eq_b in - [uu___38] in - let uu___38 + [uu___40] in + let uu___40 = FStar_Syntax_Syntax.mk_Total cod in FStar_Syntax_Util.arrow - uu___37 - uu___38 in + uu___39 + uu___40 in let nty = - let uu___37 + let uu___39 = FStar_Syntax_Syntax.mk_Total cod1 in FStar_Syntax_Util.arrow bs3 - uu___37 in - let uu___37 + uu___39 in + let uu___39 = - let uu___38 + let uu___40 = goal_typedness_deps g in @@ -8145,7 +8149,7 @@ let (t_destruct : "destruct branch" env1 nty FStar_Pervasives_Native.None - uu___38 + uu___40 (rangeof g) in Obj.magic @@ -8153,18 +8157,18 @@ let (t_destruct : FStar_Tactics_Monad.monad_tac () () (Obj.magic - uu___37) + uu___39) (fun - uu___38 + uu___40 -> (fun - uu___38 + uu___40 -> - let uu___38 + let uu___40 = Obj.magic - uu___38 in - match uu___38 + uu___40 in + match uu___40 with | (uvt, uv) @@ -8180,48 +8184,48 @@ let (t_destruct : uvt bs3 in let brt1 = - let uu___39 + let uu___41 = - let uu___40 + let uu___42 = FStar_Syntax_Syntax.as_arg FStar_Syntax_Util.exp_unit in - [uu___40] in + [uu___42] in FStar_Syntax_Util.mk_app brt - uu___39 in + uu___41 in let br = FStar_Syntax_Subst.close_branch (pat, FStar_Pervasives_Native.None, brt1) in - let uu___39 + let uu___41 = - let uu___40 + let uu___42 = - let uu___41 + let uu___43 = FStar_BigInt.of_int_fs (FStar_Compiler_List.length bs3) in (fv1, - uu___41) in + uu___43) in (g', br, - uu___40) in + uu___42) in Obj.magic (ret - uu___39)) - uu___38))) - uu___30))) - uu___27)))))) - uu___21)) + uu___41)) + uu___40))) + uu___32))) + uu___29)))))) + uu___23)) | - uu___18 + uu___19 -> Obj.repr (FStar_Tactics_Monad.fail "impossible: not a ctor")))) - uu___17) + uu___18) (Obj.magic c_lids)) in Obj.magic @@ -8229,9 +8233,9 @@ let (t_destruct : FStar_Tactics_Monad.monad_tac () () (Obj.magic - uu___16) + uu___17) (fun - uu___17 + uu___18 -> (fun goal_brs @@ -8240,11 +8244,11 @@ let (t_destruct : = Obj.magic goal_brs in - let uu___17 + let uu___18 = FStar_Compiler_List.unzip3 goal_brs in - match uu___17 + match uu___18 with | (goals, @@ -8266,7 +8270,7 @@ let (t_destruct : FStar_Pervasives_Native.None }) s_tm1.FStar_Syntax_Syntax.pos in - let uu___18 + let uu___19 = solve' g w in @@ -8274,21 +8278,21 @@ let (t_destruct : (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___18 - (fun uu___19 + (fun + uu___20 -> (fun - uu___19 + uu___20 -> - let uu___19 + let uu___20 = Obj.magic - uu___19 in + uu___20 in mark_goal_implicit_already_checked g; ( - let uu___21 + let uu___22 = FStar_Tactics_Monad.add_goals goals in @@ -8296,25 +8300,25 @@ let (t_destruct : (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___21 - (fun uu___22 + (fun + uu___23 -> (fun - uu___22 + uu___23 -> - let uu___22 + let uu___23 = Obj.magic - uu___22 in + uu___23 in Obj.magic (ret infos)) - uu___22)))) - uu___19))) - uu___17))) - uu___14))) - uu___12)) + uu___23)))) + uu___20))) + uu___18))) + uu___15))) + uu___13)) | uu___9 -> Obj.repr diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml index a40fec710a7..cfafee0fbf9 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml @@ -8077,7 +8077,9 @@ let (t_destruct : FStar_Syntax_Syntax.mutuals = mut; FStar_Syntax_Syntax.ds - = c_lids;_} + = c_lids; + FStar_Syntax_Syntax.injective_type_params + = uu___11;_} -> Obj.repr (let erasable @@ -8085,36 +8087,36 @@ let (t_destruct : FStar_Syntax_Util.has_attribute se.FStar_Syntax_Syntax.sigattrs FStar_Parser_Const.erasable_attr in - let uu___11 - = let uu___12 = + let uu___13 + = erasable && - (let uu___13 + (let uu___14 = FStar_Tactics_Monad.is_irrelevant g in Prims.op_Negation - uu___13) in + uu___14) in failwhen - uu___12 + uu___13 "cannot destruct erasable type to solve proof-relevant goal" in FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___11 - (fun uu___12 + (fun + uu___13 -> (fun - uu___12 + uu___13 -> - let uu___12 + let uu___13 = Obj.magic - uu___12 in - let uu___13 + uu___13 in + let uu___14 = failwhen ((FStar_Compiler_List.length @@ -8126,34 +8128,34 @@ let (t_destruct : (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___13 - (fun uu___14 + (fun + uu___15 -> (fun - uu___14 + uu___15 -> - let uu___14 + let uu___15 = Obj.magic - uu___14 in - let uu___15 + uu___15 in + let uu___16 = FStar_Syntax_Subst.open_term t_ps t_ty in - match uu___15 + match uu___16 with | (t_ps1, t_ty1) -> - let uu___16 + let uu___17 = Obj.magic (FStar_Class_Monad.mapM FStar_Tactics_Monad.monad_tac () () (fun - uu___17 + uu___18 -> (fun c_lid -> @@ -8161,16 +8163,16 @@ let (t_destruct : = Obj.magic c_lid in - let uu___17 - = let uu___18 = + let uu___19 + = FStar_Tactics_Types.goal_env g in FStar_TypeChecker_Env.lookup_sigelt - uu___18 + uu___19 c_lid in - match uu___17 + match uu___18 with | FStar_Pervasives_Native.None @@ -8191,33 +8193,35 @@ let (t_destruct : FStar_Syntax_Syntax.Sig_datacon { FStar_Syntax_Syntax.lid1 - = uu___18; + = uu___19; FStar_Syntax_Syntax.us1 = c_us; FStar_Syntax_Syntax.t1 = c_ty; FStar_Syntax_Syntax.ty_lid - = uu___19; + = uu___20; FStar_Syntax_Syntax.num_ty_params = nparam; FStar_Syntax_Syntax.mutuals1 - = mut1;_} + = mut1; + FStar_Syntax_Syntax.injective_type_params1 + = uu___21;_} -> Obj.repr (let qual = let fallback - uu___20 = + uu___22 = FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor in let qninfo = - let uu___20 + let uu___22 = FStar_Tactics_Types.goal_env g in FStar_TypeChecker_Env.lookup_qname - uu___20 + uu___22 c_lid in match qninfo with @@ -8230,7 +8234,7 @@ let (t_destruct : FStar_Syntax_DsEnv.fv_qual_of_se se2 | - uu___20 + uu___22 -> fallback () in @@ -8238,7 +8242,7 @@ let (t_destruct : FStar_Syntax_Syntax.lid_as_fv c_lid qual in - let uu___20 + let uu___22 = failwhen ((FStar_Compiler_List.length @@ -8249,17 +8253,17 @@ let (t_destruct : FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___20 + uu___22 (fun - uu___21 + uu___23 -> (fun - uu___21 + uu___23 -> - let uu___21 + let uu___23 = Obj.magic - uu___21 in + uu___23 in let s = FStar_TypeChecker_Env.mk_univ_subst c_us a_us in @@ -8267,26 +8271,26 @@ let (t_destruct : = FStar_Syntax_Subst.subst s c_ty in - let uu___22 + let uu___24 = FStar_TypeChecker_Env.inst_tscheme (c_us, c_ty1) in - match uu___22 + match uu___24 with | (c_us1, c_ty2) -> - let uu___23 + let uu___25 = FStar_Syntax_Util.arrow_formals_comp c_ty2 in - (match uu___23 + (match uu___25 with | (bs, comp) -> - let uu___24 + let uu___26 = let rename_bv bv = @@ -8295,26 +8299,26 @@ let (t_destruct : bv.FStar_Syntax_Syntax.ppname in let ppname1 = - let uu___25 + let uu___27 = - let uu___26 + let uu___28 = - let uu___27 + let uu___29 = FStar_Class_Show.show FStar_Ident.showable_ident ppname in Prims.strcat "a" - uu___27 in - let uu___27 + uu___29 in + let uu___29 = FStar_Ident.range_of_id ppname in - (uu___26, - uu___27) in + (uu___28, + uu___29) in FStar_Ident.mk_ident - uu___25 in + uu___27 in FStar_Syntax_Syntax.freshen_bv { FStar_Syntax_Syntax.ppname @@ -8329,13 +8333,13 @@ let (t_destruct : let bs' = FStar_Compiler_List.map (fun b -> - let uu___25 + let uu___27 = rename_bv b.FStar_Syntax_Syntax.binder_bv in { FStar_Syntax_Syntax.binder_bv - = uu___25; + = uu___27; FStar_Syntax_Syntax.binder_qual = (b.FStar_Syntax_Syntax.binder_qual); @@ -8350,100 +8354,100 @@ let (t_destruct : = FStar_Compiler_List.map2 (fun - uu___25 + uu___27 -> fun - uu___26 + uu___28 -> match - (uu___25, - uu___26) + (uu___27, + uu___28) with | ({ FStar_Syntax_Syntax.binder_bv = bv; FStar_Syntax_Syntax.binder_qual - = uu___27; + = uu___29; FStar_Syntax_Syntax.binder_positivity - = uu___28; + = uu___30; FStar_Syntax_Syntax.binder_attrs - = uu___29;_}, + = uu___31;_}, { FStar_Syntax_Syntax.binder_bv = bv'; FStar_Syntax_Syntax.binder_qual - = uu___30; + = uu___32; FStar_Syntax_Syntax.binder_positivity - = uu___31; + = uu___33; FStar_Syntax_Syntax.binder_attrs - = uu___32;_}) + = uu___34;_}) -> - let uu___33 + let uu___35 = - let uu___34 + let uu___36 = FStar_Syntax_Syntax.bv_to_name bv' in (bv, - uu___34) in + uu___36) in FStar_Syntax_Syntax.NT - uu___33) + uu___35) bs bs' in - let uu___25 + let uu___27 = FStar_Syntax_Subst.subst_binders subst bs' in - let uu___26 + let uu___28 = FStar_Syntax_Subst.subst_comp subst comp in - (uu___25, - uu___26) in - (match uu___24 + (uu___27, + uu___28) in + (match uu___26 with | (bs1, comp1) -> - let uu___25 + let uu___27 = FStar_Compiler_List.splitAt nparam bs1 in - (match uu___25 + (match uu___27 with | (d_ps, bs2) -> - let uu___26 + let uu___28 = - let uu___27 + let uu___29 = - let uu___28 + let uu___30 = FStar_Syntax_Util.is_total_comp comp1 in Prims.op_Negation - uu___28 in + uu___30 in failwhen - uu___27 + uu___29 "not total?" in Obj.magic (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___26 + uu___28 (fun - uu___27 + uu___29 -> (fun - uu___27 + uu___29 -> - let uu___27 + let uu___29 = Obj.magic - uu___27 in + uu___29 in let mk_pat p = { @@ -8454,28 +8458,28 @@ let (t_destruct : (s_tm1.FStar_Syntax_Syntax.pos) } in let is_imp - uu___28 = - match uu___28 + uu___30 = + match uu___30 with | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit - uu___29) + uu___31) -> true | - uu___29 + uu___31 -> false in - let uu___28 + let uu___30 = FStar_Compiler_List.splitAt nparam args in - match uu___28 + match uu___30 with | (a_ps, a_is) -> - let uu___29 + let uu___31 = failwhen ((FStar_Compiler_List.length @@ -8487,17 +8491,17 @@ let (t_destruct : (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___29 + uu___31 (fun - uu___30 + uu___32 -> (fun - uu___30 + uu___32 -> - let uu___30 + let uu___32 = Obj.magic - uu___30 in + uu___32 in let d_ps_a_ps = FStar_Compiler_List.zip @@ -8506,22 +8510,22 @@ let (t_destruct : = FStar_Compiler_List.map (fun - uu___31 + uu___33 -> - match uu___31 + match uu___33 with | ({ FStar_Syntax_Syntax.binder_bv = bv; FStar_Syntax_Syntax.binder_qual - = uu___32; + = uu___34; FStar_Syntax_Syntax.binder_positivity - = uu___33; + = uu___35; FStar_Syntax_Syntax.binder_attrs - = uu___34;_}, + = uu___36;_}, (t, - uu___35)) + uu___37)) -> FStar_Syntax_Syntax.NT (bv, t)) @@ -8533,22 +8537,22 @@ let (t_destruct : = FStar_Compiler_List.map (fun - uu___31 + uu___33 -> - match uu___31 + match uu___33 with | ({ FStar_Syntax_Syntax.binder_bv = bv; FStar_Syntax_Syntax.binder_qual - = uu___32; + = uu___34; FStar_Syntax_Syntax.binder_positivity - = uu___33; + = uu___35; FStar_Syntax_Syntax.binder_attrs - = uu___34;_}, + = uu___36;_}, (t, - uu___35)) + uu___37)) -> ((mk_pat (FStar_Syntax_Syntax.Pat_dot_term @@ -8560,9 +8564,9 @@ let (t_destruct : = FStar_Compiler_List.map (fun - uu___31 + uu___33 -> - match uu___31 + match uu___33 with | { @@ -8571,9 +8575,9 @@ let (t_destruct : FStar_Syntax_Syntax.binder_qual = bq; FStar_Syntax_Syntax.binder_positivity - = uu___32; + = uu___34; FStar_Syntax_Syntax.binder_attrs - = uu___33;_} + = uu___35;_} -> ((mk_pat (FStar_Syntax_Syntax.Pat_var @@ -8603,7 +8607,7 @@ let (t_destruct : env1.FStar_TypeChecker_Env.universe_of env1 s_ty1 in - let uu___31 + let uu___33 = FStar_TypeChecker_TcTerm.tc_pat { @@ -8764,23 +8768,23 @@ let (t_destruct : (env1.FStar_TypeChecker_Env.core_check) } s_ty1 pat in - match uu___31 + match uu___33 with | - (uu___32, - uu___33, - uu___34, + (uu___34, uu___35, - pat_t, uu___36, + uu___37, + pat_t, + uu___38, _guard_pat, _erasable) -> let eq_b = - let uu___37 + let uu___39 = - let uu___38 + let uu___40 = FStar_Syntax_Util.mk_eq2 equ s_ty1 @@ -8788,38 +8792,38 @@ let (t_destruct : pat_t in FStar_Syntax_Util.mk_squash FStar_Syntax_Syntax.U_zero - uu___38 in + uu___40 in FStar_Syntax_Syntax.gen_bv "breq" FStar_Pervasives_Native.None - uu___37 in + uu___39 in let cod1 = - let uu___37 + let uu___39 = - let uu___38 + let uu___40 = FStar_Syntax_Syntax.mk_binder eq_b in - [uu___38] in - let uu___38 + [uu___40] in + let uu___40 = FStar_Syntax_Syntax.mk_Total cod in FStar_Syntax_Util.arrow - uu___37 - uu___38 in + uu___39 + uu___40 in let nty = - let uu___37 + let uu___39 = FStar_Syntax_Syntax.mk_Total cod1 in FStar_Syntax_Util.arrow bs3 - uu___37 in - let uu___37 + uu___39 in + let uu___39 = - let uu___38 + let uu___40 = FStar_Tactics_Monad.goal_typedness_deps g in @@ -8827,7 +8831,7 @@ let (t_destruct : "destruct branch" env1 nty FStar_Pervasives_Native.None - uu___38 + uu___40 (rangeof g) in Obj.magic @@ -8835,18 +8839,18 @@ let (t_destruct : FStar_Tactics_Monad.monad_tac () () (Obj.magic - uu___37) + uu___39) (fun - uu___38 + uu___40 -> (fun - uu___38 + uu___40 -> - let uu___38 + let uu___40 = Obj.magic - uu___38 in - match uu___38 + uu___40 in + match uu___40 with | (uvt, uv) @@ -8862,51 +8866,51 @@ let (t_destruct : uvt bs3 in let brt1 = - let uu___39 + let uu___41 = - let uu___40 + let uu___42 = FStar_Syntax_Syntax.as_arg FStar_Syntax_Util.exp_unit in - [uu___40] in + [uu___42] in FStar_Syntax_Util.mk_app brt - uu___39 in + uu___41 in let br = FStar_Syntax_Subst.close_branch (pat, FStar_Pervasives_Native.None, brt1) in - let uu___39 + let uu___41 = - let uu___40 + let uu___42 = - let uu___41 + let uu___43 = FStar_BigInt.of_int_fs (FStar_Compiler_List.length bs3) in (fv1, - uu___41) in + uu___43) in (g', br, - uu___40) in + uu___42) in Obj.magic (FStar_Class_Monad.return FStar_Tactics_Monad.monad_tac () (Obj.magic - uu___39))) - uu___38))) - uu___30))) - uu___27)))))) - uu___21)) + uu___41))) + uu___40))) + uu___32))) + uu___29)))))) + uu___23)) | - uu___18 + uu___19 -> Obj.repr (FStar_Tactics_Monad.fail "impossible: not a ctor")))) - uu___17) + uu___18) (Obj.magic c_lids)) in Obj.magic @@ -8914,9 +8918,9 @@ let (t_destruct : FStar_Tactics_Monad.monad_tac () () (Obj.magic - uu___16) + uu___17) (fun - uu___17 + uu___18 -> (fun goal_brs @@ -8925,11 +8929,11 @@ let (t_destruct : = Obj.magic goal_brs in - let uu___17 + let uu___18 = FStar_Compiler_List.unzip3 goal_brs in - match uu___17 + match uu___18 with | (goals, @@ -8951,7 +8955,7 @@ let (t_destruct : FStar_Pervasives_Native.None }) s_tm1.FStar_Syntax_Syntax.pos in - let uu___18 + let uu___19 = solve' g w in @@ -8959,21 +8963,21 @@ let (t_destruct : (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___18 - (fun uu___19 + (fun + uu___20 -> (fun - uu___19 + uu___20 -> - let uu___19 + let uu___20 = Obj.magic - uu___19 in + uu___20 in FStar_Tactics_Monad.mark_goal_implicit_already_checked g; ( - let uu___21 + let uu___22 = FStar_Tactics_Monad.add_goals goals in @@ -8981,28 +8985,28 @@ let (t_destruct : (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___21 - (fun uu___22 + (fun + uu___23 -> (fun - uu___22 + uu___23 -> - let uu___22 + let uu___23 = Obj.magic - uu___22 in + uu___23 in Obj.magic (FStar_Class_Monad.return FStar_Tactics_Monad.monad_tac () (Obj.magic infos))) - uu___22)))) - uu___19))) - uu___17))) - uu___14))) - uu___12)) + uu___23)))) + uu___20))) + uu___18))) + uu___15))) + uu___13)) | uu___9 -> Obj.repr diff --git a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml index 710914b9822..bc18fe7f8bf 100644 --- a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml +++ b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml @@ -1170,30 +1170,33 @@ let rec (generalize_annotated_univs : FStar_Syntax_Syntax.num_uniform_params = num_uniform; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = lids1; - FStar_Syntax_Syntax.ds = lids2;_} + FStar_Syntax_Syntax.ds = lids2; + FStar_Syntax_Syntax.injective_type_params = uu___5;_} -> - let uu___5 = - let uu___6 = - let uu___7 = - FStar_Syntax_Subst.subst_binders usubst bs in + let uu___6 = + let uu___7 = let uu___8 = - let uu___9 = + FStar_Syntax_Subst.subst_binders usubst bs in + let uu___9 = + let uu___10 = FStar_Syntax_Subst.shift_subst (FStar_Compiler_List.length bs) usubst in - FStar_Syntax_Subst.subst uu___9 t in + FStar_Syntax_Subst.subst uu___10 t in { FStar_Syntax_Syntax.lid = lid; FStar_Syntax_Syntax.us = unames; - FStar_Syntax_Syntax.params = uu___7; + FStar_Syntax_Syntax.params = uu___8; FStar_Syntax_Syntax.num_uniform_params = num_uniform; - FStar_Syntax_Syntax.t = uu___8; + FStar_Syntax_Syntax.t = uu___9; FStar_Syntax_Syntax.mutuals = lids1; - FStar_Syntax_Syntax.ds = lids2 + FStar_Syntax_Syntax.ds = lids2; + FStar_Syntax_Syntax.injective_type_params = + false } in - FStar_Syntax_Syntax.Sig_inductive_typ uu___6 in + FStar_Syntax_Syntax.Sig_inductive_typ uu___7 in { - FStar_Syntax_Syntax.sigel = uu___5; + FStar_Syntax_Syntax.sigel = uu___6; FStar_Syntax_Syntax.sigrng = (se.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = @@ -1213,22 +1216,25 @@ let rec (generalize_annotated_univs : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = tlid; FStar_Syntax_Syntax.num_ty_params = n; - FStar_Syntax_Syntax.mutuals1 = lids1;_} + FStar_Syntax_Syntax.mutuals1 = lids1; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> - let uu___5 = - let uu___6 = - let uu___7 = FStar_Syntax_Subst.subst usubst t in + let uu___6 = + let uu___7 = + let uu___8 = FStar_Syntax_Subst.subst usubst t in { FStar_Syntax_Syntax.lid1 = lid; FStar_Syntax_Syntax.us1 = unames; - FStar_Syntax_Syntax.t1 = uu___7; + FStar_Syntax_Syntax.t1 = uu___8; FStar_Syntax_Syntax.ty_lid = tlid; FStar_Syntax_Syntax.num_ty_params = n; - FStar_Syntax_Syntax.mutuals1 = lids1 + FStar_Syntax_Syntax.mutuals1 = lids1; + FStar_Syntax_Syntax.injective_type_params1 = + false } in - FStar_Syntax_Syntax.Sig_datacon uu___6 in + FStar_Syntax_Syntax.Sig_datacon uu___7 in { - FStar_Syntax_Syntax.sigel = uu___5; + FStar_Syntax_Syntax.sigel = uu___6; FStar_Syntax_Syntax.sigrng = (se.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = @@ -6660,32 +6666,33 @@ let (mk_data_projector_names : FStar_Syntax_Syntax.us1 = uu___; FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___1; FStar_Syntax_Syntax.num_ty_params = n; - FStar_Syntax_Syntax.mutuals1 = uu___2;_} + FStar_Syntax_Syntax.mutuals1 = uu___2; + FStar_Syntax_Syntax.injective_type_params1 = uu___3;_} -> - let uu___3 = FStar_Syntax_Util.arrow_formals t in - (match uu___3 with - | (formals, uu___4) -> + let uu___4 = FStar_Syntax_Util.arrow_formals t in + (match uu___4 with + | (formals, uu___5) -> (match formals with | [] -> [] - | uu___5 -> - let filter_records uu___6 = - match uu___6 with + | uu___6 -> + let filter_records uu___7 = + match uu___7 with | FStar_Syntax_Syntax.RecordConstructor - (uu___7, fns) -> + (uu___8, fns) -> FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor (lid, fns)) - | uu___7 -> FStar_Pervasives_Native.None in + | uu___8 -> FStar_Pervasives_Native.None in let fv_qual = - let uu___6 = + let uu___7 = FStar_Compiler_Util.find_map se.FStar_Syntax_Syntax.sigquals filter_records in - match uu___6 with + match uu___7 with | FStar_Pervasives_Native.None -> FStar_Syntax_Syntax.Data_ctor | FStar_Pervasives_Native.Some q -> q in - let uu___6 = FStar_Compiler_Util.first_N n formals in - (match uu___6 with - | (uu___7, rest) -> + let uu___7 = FStar_Compiler_Util.first_N n formals in + (match uu___7 with + | (uu___8, rest) -> mk_indexed_projector_names iquals fv_qual se.FStar_Syntax_Syntax.sigattrs env lid rest))) | uu___ -> []) @@ -7072,7 +7079,9 @@ let rec (desugar_tycon : FStar_Pervasives_Native.None; FStar_Syntax_Syntax.t = k1; FStar_Syntax_Syntax.mutuals = mutuals; - FStar_Syntax_Syntax.ds = [] + FStar_Syntax_Syntax.ds = []; + FStar_Syntax_Syntax.injective_type_params = + false }); FStar_Syntax_Syntax.sigrng = uu___2; FStar_Syntax_Syntax.sigquals = quals1; @@ -7138,7 +7147,9 @@ let rec (desugar_tycon : FStar_Syntax_Syntax.num_uniform_params = uu___5; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = []; - FStar_Syntax_Syntax.ds = [];_} + FStar_Syntax_Syntax.ds = []; + FStar_Syntax_Syntax.injective_type_params = + uu___6;_} -> let quals1 = se.FStar_Syntax_Syntax.sigquals in let quals2 = @@ -7147,22 +7158,22 @@ let rec (desugar_tycon : FStar_Syntax_Syntax.Assumption quals1 then quals1 else - ((let uu___8 = - let uu___9 = FStar_Options.ml_ish () in - Prims.op_Negation uu___9 in - if uu___8 + ((let uu___9 = + let uu___10 = FStar_Options.ml_ish () in + Prims.op_Negation uu___10 in + if uu___9 then - let uu___9 = - let uu___10 = - let uu___11 = + let uu___10 = + let uu___11 = + let uu___12 = FStar_Syntax_Print.lid_to_string l in FStar_Compiler_Util.format1 "Adding an implicit 'assume new' qualifier on %s" - uu___11 in + uu___12 in (FStar_Errors_Codes.Warning_AddImplicitAssumeNewQualifier, - uu___10) in + uu___11) in FStar_Errors.log_issue - se.FStar_Syntax_Syntax.sigrng uu___9 + se.FStar_Syntax_Syntax.sigrng uu___10 else ()); FStar_Syntax_Syntax.Assumption :: @@ -7172,17 +7183,17 @@ let rec (desugar_tycon : let t = match typars with | [] -> k - | uu___6 -> - let uu___7 = - let uu___8 = - let uu___9 = + | uu___7 -> + let uu___8 = + let uu___9 = + let uu___10 = FStar_Syntax_Syntax.mk_Total k in { FStar_Syntax_Syntax.bs1 = typars; - FStar_Syntax_Syntax.comp = uu___9 + FStar_Syntax_Syntax.comp = uu___10 } in - FStar_Syntax_Syntax.Tm_arrow uu___8 in - FStar_Syntax_Syntax.mk uu___7 + FStar_Syntax_Syntax.Tm_arrow uu___9 in + FStar_Syntax_Syntax.mk uu___8 se.FStar_Syntax_Syntax.sigrng in { FStar_Syntax_Syntax.sigel = @@ -7421,37 +7432,39 @@ let rec (desugar_tycon : = uu___4; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params + = uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; FStar_Syntax_Syntax.sigopens_and_abbrevs = - uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_}, + uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_}, binders, t, quals1) -> let t1 = - let uu___13 = + let uu___14 = typars_of_binders env1 binders in - match uu___13 with + match uu___14 with | (env2, tpars1) -> - let uu___14 = push_tparams env2 tpars1 in - (match uu___14 with + let uu___15 = push_tparams env2 tpars1 in + (match uu___15 with | (env_tps, tpars2) -> let t2 = desugar_typ env_tps t in let tpars3 = FStar_Syntax_Subst.close_binders tpars2 in FStar_Syntax_Subst.close tpars3 t2) in - let uu___13 = - let uu___14 = - let uu___15 = FStar_Ident.range_of_lid id in + let uu___14 = + let uu___15 = + let uu___16 = FStar_Ident.range_of_lid id in mk_typ_abbrev env1 d id uvs tpars (FStar_Pervasives_Native.Some k) t1 - [id] quals1 uu___15 in - ([], uu___14) in - [uu___13] + [id] quals1 uu___16 in + ([], uu___15) in + [uu___14] | FStar_Pervasives.Inl ({ FStar_Syntax_Syntax.sigel = @@ -7463,7 +7476,9 @@ let rec (desugar_tycon : = num_uniform; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = mutuals1; - FStar_Syntax_Syntax.ds = uu___4;_}; + FStar_Syntax_Syntax.ds = uu___4; + FStar_Syntax_Syntax.injective_type_params + = injective_type_params;_}; FStar_Syntax_Syntax.sigrng = uu___5; FStar_Syntax_Syntax.sigquals = tname_quals; FStar_Syntax_Syntax.sigmeta = uu___6; @@ -7613,7 +7628,10 @@ let rec (desugar_tycon : FStar_Syntax_Syntax.num_ty_params = ntps; FStar_Syntax_Syntax.mutuals1 - = mutuals1 + = mutuals1; + FStar_Syntax_Syntax.injective_type_params1 + = + injective_type_params } in FStar_Syntax_Syntax.Sig_datacon uu___17 in @@ -7715,7 +7733,10 @@ let rec (desugar_tycon : FStar_Syntax_Syntax.mutuals = mutuals1; FStar_Syntax_Syntax.ds - = constrNames + = constrNames; + FStar_Syntax_Syntax.injective_type_params + = + injective_type_params }); FStar_Syntax_Syntax.sigrng = uu___15; @@ -7784,16 +7805,18 @@ let rec (desugar_tycon : = uu___6; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___7; - FStar_Syntax_Syntax.ds = constrs;_} + FStar_Syntax_Syntax.ds = constrs; + FStar_Syntax_Syntax.injective_type_params + = uu___8;_} -> let quals1 = se.FStar_Syntax_Syntax.sigquals in - let uu___8 = + let uu___9 = FStar_Compiler_List.filter (fun data_lid -> let data_quals = let data_se = - let uu___9 = + let uu___10 = FStar_Compiler_List.find (fun se1 -> match se1.FStar_Syntax_Syntax.sigel @@ -7803,35 +7826,37 @@ let rec (desugar_tycon : FStar_Syntax_Syntax.lid1 = name; FStar_Syntax_Syntax.us1 - = uu___10; - FStar_Syntax_Syntax.t1 = uu___11; - FStar_Syntax_Syntax.ty_lid + FStar_Syntax_Syntax.t1 = uu___12; - FStar_Syntax_Syntax.num_ty_params + FStar_Syntax_Syntax.ty_lid = uu___13; + FStar_Syntax_Syntax.num_ty_params + = uu___14; FStar_Syntax_Syntax.mutuals1 - = uu___14;_} + = uu___15; + FStar_Syntax_Syntax.injective_type_params1 + = uu___16;_} -> FStar_Ident.lid_equals name data_lid - | uu___10 -> false) + | uu___11 -> false) sigelts in FStar_Compiler_Util.must - uu___9 in + uu___10 in data_se.FStar_Syntax_Syntax.sigquals in - let uu___9 = + let uu___10 = FStar_Compiler_List.existsb - (fun uu___10 -> - match uu___10 with + (fun uu___11 -> + match uu___11 with | FStar_Syntax_Syntax.RecordConstructor - uu___11 -> true - | uu___11 -> false) + uu___12 -> true + | uu___12 -> false) data_quals in - Prims.op_Negation uu___9) + Prims.op_Negation uu___10) constrs in mk_data_discriminators quals1 env3 - uu___8 + uu___9 se.FStar_Syntax_Syntax.sigattrs | uu___5 -> []) sigelts in let ops = @@ -9275,12 +9300,14 @@ and (desugar_decl_core : FStar_Syntax_Syntax.num_ty_params = uu___6; FStar_Syntax_Syntax.mutuals1 = - uu___7;_} + uu___7; + FStar_Syntax_Syntax.injective_type_params1 + = uu___8;_} -> - let uu___8 = + let uu___9 = FStar_Syntax_Util.arrow_formals t in - (match uu___8 with - | (formals1, uu___9) -> + (match uu___9 with + | (formals1, uu___10) -> FStar_Pervasives_Native.Some formals1) | uu___3 -> FStar_Pervasives_Native.None) @@ -9300,7 +9327,8 @@ and (desugar_decl_core : FStar_Syntax_Syntax.num_uniform_params = uu___4; FStar_Syntax_Syntax.t = ty; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_} + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_} -> let formals1 = match formals with @@ -9311,44 +9339,44 @@ and (desugar_decl_core : let i = FStar_Ident.ident_of_lid meth in FStar_Compiler_Util.for_some (fun formal -> - let uu___7 = + let uu___8 = FStar_Ident.ident_equals i (formal.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.ppname in - if uu___7 + if uu___8 then FStar_Compiler_Util.for_some (fun attr -> - let uu___8 = - let uu___9 = + let uu___9 = + let uu___10 = FStar_Syntax_Subst.compress attr in - uu___9.FStar_Syntax_Syntax.n in - match uu___8 with + uu___10.FStar_Syntax_Syntax.n in + match uu___9 with | FStar_Syntax_Syntax.Tm_fvar fv -> FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.no_method_lid - | uu___9 -> false) + | uu___10 -> false) formal.FStar_Syntax_Syntax.binder_attrs else false) formals1 in let meths1 = FStar_Compiler_List.filter (fun x -> - let uu___7 = has_no_method_attr x in - Prims.op_Negation uu___7) meths in + let uu___8 = has_no_method_attr x in + Prims.op_Negation uu___8) meths in let is_typed = false in - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = mkclass lid in + let uu___8 = + let uu___9 = + let uu___10 = + let uu___11 = mkclass lid in { FStar_Syntax_Syntax.is_typed = is_typed; FStar_Syntax_Syntax.lids2 = meths1; - FStar_Syntax_Syntax.tac = uu___10 + FStar_Syntax_Syntax.tac = uu___11 } in - FStar_Syntax_Syntax.Sig_splice uu___9 in - let uu___9 = + FStar_Syntax_Syntax.Sig_splice uu___10 in + let uu___10 = FStar_Syntax_DsEnv.opens_and_abbrevs env1 in { - FStar_Syntax_Syntax.sigel = uu___8; + FStar_Syntax_Syntax.sigel = uu___9; FStar_Syntax_Syntax.sigrng = (d.FStar_Parser_AST.drange); FStar_Syntax_Syntax.sigquals = []; @@ -9356,11 +9384,11 @@ and (desugar_decl_core : FStar_Syntax_Syntax.default_sigmeta; FStar_Syntax_Syntax.sigattrs = []; FStar_Syntax_Syntax.sigopens_and_abbrevs = - uu___9; + uu___10; FStar_Syntax_Syntax.sigopts = FStar_Pervasives_Native.None } in - [uu___7] + [uu___8] | uu___2 -> [] in let uu___2 = if typeclass @@ -9865,7 +9893,8 @@ and (desugar_decl_core : FStar_Parser_Const.exn_lid; FStar_Syntax_Syntax.num_ty_params = Prims.int_zero; FStar_Syntax_Syntax.mutuals1 = - [FStar_Parser_Const.exn_lid] + [FStar_Parser_Const.exn_lid]; + FStar_Syntax_Syntax.injective_type_params1 = false }); FStar_Syntax_Syntax.sigrng = (d.FStar_Parser_AST.drange); FStar_Syntax_Syntax.sigquals = qual; diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Cfg.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Cfg.ml index d7ade7dd769..0ec4b48ca35 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Cfg.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Cfg.ml @@ -2424,8 +2424,8 @@ let (config' : let steps = let uu___ = to_fsteps s in add_nbe uu___ in let psteps1 = let uu___ = - let uu___1 = cached_steps () in - let uu___2 = env_dependent_ops e in merge_steps uu___1 uu___2 in + let uu___1 = env_dependent_ops e in + let uu___2 = cached_steps () in merge_steps uu___1 uu___2 in add_steps uu___ psteps in let dbg_flag = FStar_Compiler_List.contains FStar_TypeChecker_Env.NormDebug s in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml index c724c1fbd98..b106e67b263 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml @@ -3141,18 +3141,19 @@ let (try_lookup_lid_aux : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_}; - FStar_Syntax_Syntax.sigrng = uu___5; - FStar_Syntax_Syntax.sigquals = uu___6; - FStar_Syntax_Syntax.sigmeta = uu___7; - FStar_Syntax_Syntax.sigattrs = uu___8; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; - FStar_Syntax_Syntax.sigopts = uu___10;_}, + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_}; + FStar_Syntax_Syntax.sigrng = uu___6; + FStar_Syntax_Syntax.sigquals = uu___7; + FStar_Syntax_Syntax.sigmeta = uu___8; + FStar_Syntax_Syntax.sigattrs = uu___9; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___10; + FStar_Syntax_Syntax.sigopts = uu___11;_}, FStar_Pervasives_Native.None) -> - let uu___11 = - let uu___12 = inst_tscheme1 (uvs, t) in (uu___12, rng) in - FStar_Pervasives_Native.Some uu___11 + let uu___12 = + let uu___13 = inst_tscheme1 (uvs, t) in (uu___13, rng) in + FStar_Pervasives_Native.Some uu___12 | FStar_Pervasives.Inr ({ FStar_Syntax_Syntax.sigel = @@ -3196,32 +3197,33 @@ let (try_lookup_lid_aux : FStar_Syntax_Syntax.num_uniform_params = uu___1; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___2; - FStar_Syntax_Syntax.ds = uu___3;_}; - FStar_Syntax_Syntax.sigrng = uu___4; - FStar_Syntax_Syntax.sigquals = uu___5; - FStar_Syntax_Syntax.sigmeta = uu___6; - FStar_Syntax_Syntax.sigattrs = uu___7; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___8; - FStar_Syntax_Syntax.sigopts = uu___9;_}, + FStar_Syntax_Syntax.ds = uu___3; + FStar_Syntax_Syntax.injective_type_params = uu___4;_}; + FStar_Syntax_Syntax.sigrng = uu___5; + FStar_Syntax_Syntax.sigquals = uu___6; + FStar_Syntax_Syntax.sigmeta = uu___7; + FStar_Syntax_Syntax.sigattrs = uu___8; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; + FStar_Syntax_Syntax.sigopts = uu___10;_}, FStar_Pervasives_Native.None) -> (match tps with | [] -> - let uu___10 = - let uu___11 = inst_tscheme1 (uvs, k) in - (uu___11, rng) in - FStar_Pervasives_Native.Some uu___10 - | uu___10 -> let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = - let uu___15 = FStar_Syntax_Syntax.mk_Total k in - FStar_Syntax_Util.flat_arrow tps uu___15 in - (uvs, uu___14) in - inst_tscheme1 uu___13 in + let uu___12 = inst_tscheme1 (uvs, k) in (uu___12, rng) in - FStar_Pervasives_Native.Some uu___11) + FStar_Pervasives_Native.Some uu___11 + | uu___11 -> + let uu___12 = + let uu___13 = + let uu___14 = + let uu___15 = + let uu___16 = FStar_Syntax_Syntax.mk_Total k in + FStar_Syntax_Util.flat_arrow tps uu___16 in + (uvs, uu___15) in + inst_tscheme1 uu___14 in + (uu___13, rng) in + FStar_Pervasives_Native.Some uu___12) | FStar_Pervasives.Inr ({ FStar_Syntax_Syntax.sigel = @@ -3232,32 +3234,33 @@ let (try_lookup_lid_aux : FStar_Syntax_Syntax.num_uniform_params = uu___1; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___2; - FStar_Syntax_Syntax.ds = uu___3;_}; - FStar_Syntax_Syntax.sigrng = uu___4; - FStar_Syntax_Syntax.sigquals = uu___5; - FStar_Syntax_Syntax.sigmeta = uu___6; - FStar_Syntax_Syntax.sigattrs = uu___7; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___8; - FStar_Syntax_Syntax.sigopts = uu___9;_}, + FStar_Syntax_Syntax.ds = uu___3; + FStar_Syntax_Syntax.injective_type_params = uu___4;_}; + FStar_Syntax_Syntax.sigrng = uu___5; + FStar_Syntax_Syntax.sigquals = uu___6; + FStar_Syntax_Syntax.sigmeta = uu___7; + FStar_Syntax_Syntax.sigattrs = uu___8; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; + FStar_Syntax_Syntax.sigopts = uu___10;_}, FStar_Pervasives_Native.Some us) -> (match tps with | [] -> - let uu___10 = - let uu___11 = inst_tscheme_with (uvs, k) us in - (uu___11, rng) in - FStar_Pervasives_Native.Some uu___10 - | uu___10 -> let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = - let uu___15 = FStar_Syntax_Syntax.mk_Total k in - FStar_Syntax_Util.flat_arrow tps uu___15 in - (uvs, uu___14) in - inst_tscheme_with uu___13 us in + let uu___12 = inst_tscheme_with (uvs, k) us in (uu___12, rng) in - FStar_Pervasives_Native.Some uu___11) + FStar_Pervasives_Native.Some uu___11 + | uu___11 -> + let uu___12 = + let uu___13 = + let uu___14 = + let uu___15 = + let uu___16 = FStar_Syntax_Syntax.mk_Total k in + FStar_Syntax_Util.flat_arrow tps uu___16 in + (uvs, uu___15) in + inst_tscheme_with uu___14 us in + (uu___13, rng) in + FStar_Pervasives_Native.Some uu___12) | FStar_Pervasives.Inr se -> let uu___1 = match se with @@ -3481,18 +3484,19 @@ let (lookup_datacon : FStar_Syntax_Syntax.us1 = uvs; FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_}; - FStar_Syntax_Syntax.sigrng = uu___5; - FStar_Syntax_Syntax.sigquals = uu___6; - FStar_Syntax_Syntax.sigmeta = uu___7; - FStar_Syntax_Syntax.sigattrs = uu___8; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; - FStar_Syntax_Syntax.sigopts = uu___10;_}, + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_}; + FStar_Syntax_Syntax.sigrng = uu___6; + FStar_Syntax_Syntax.sigquals = uu___7; + FStar_Syntax_Syntax.sigmeta = uu___8; + FStar_Syntax_Syntax.sigattrs = uu___9; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___10; + FStar_Syntax_Syntax.sigopts = uu___11;_}, FStar_Pervasives_Native.None), - uu___11) + uu___12) -> - let uu___12 = FStar_Ident.range_of_lid lid in - inst_tscheme_with_range uu___12 (uvs, t) + let uu___13 = FStar_Ident.range_of_lid lid in + inst_tscheme_with_range uu___13 (uvs, t) | uu___1 -> let uu___2 = name_not_found lid in let uu___3 = FStar_Ident.range_of_lid lid in @@ -3516,18 +3520,19 @@ let (lookup_and_inst_datacon : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_}; - FStar_Syntax_Syntax.sigrng = uu___5; - FStar_Syntax_Syntax.sigquals = uu___6; - FStar_Syntax_Syntax.sigmeta = uu___7; - FStar_Syntax_Syntax.sigattrs = uu___8; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; - FStar_Syntax_Syntax.sigopts = uu___10;_}, + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_}; + FStar_Syntax_Syntax.sigrng = uu___6; + FStar_Syntax_Syntax.sigquals = uu___7; + FStar_Syntax_Syntax.sigmeta = uu___8; + FStar_Syntax_Syntax.sigattrs = uu___9; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___10; + FStar_Syntax_Syntax.sigopts = uu___11;_}, FStar_Pervasives_Native.None), - uu___11) + uu___12) -> - let uu___12 = inst_tscheme_with (uvs, t) us in - FStar_Pervasives_Native.snd uu___12 + let uu___13 = inst_tscheme_with (uvs, t) us in + FStar_Pervasives_Native.snd uu___13 | uu___1 -> let uu___2 = name_not_found lid in let uu___3 = FStar_Ident.range_of_lid lid in @@ -3550,15 +3555,16 @@ let (datacons_of_typ : FStar_Syntax_Syntax.num_uniform_params = uu___4; FStar_Syntax_Syntax.t = uu___5; FStar_Syntax_Syntax.mutuals = uu___6; - FStar_Syntax_Syntax.ds = dcs;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_}, - uu___13), - uu___14) + FStar_Syntax_Syntax.ds = dcs; + FStar_Syntax_Syntax.injective_type_params = uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_}, + uu___14), + uu___15) -> (true, dcs) | uu___1 -> (false, []) let (typ_of_datacon : env -> FStar_Ident.lident -> FStar_Ident.lident) = @@ -3575,22 +3581,23 @@ let (typ_of_datacon : env -> FStar_Ident.lident -> FStar_Ident.lident) = FStar_Syntax_Syntax.t1 = uu___3; FStar_Syntax_Syntax.ty_lid = l; FStar_Syntax_Syntax.num_ty_params = uu___4; - FStar_Syntax_Syntax.mutuals1 = uu___5;_}; - FStar_Syntax_Syntax.sigrng = uu___6; - FStar_Syntax_Syntax.sigquals = uu___7; - FStar_Syntax_Syntax.sigmeta = uu___8; - FStar_Syntax_Syntax.sigattrs = uu___9; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___10; - FStar_Syntax_Syntax.sigopts = uu___11;_}, - uu___12), - uu___13) + FStar_Syntax_Syntax.mutuals1 = uu___5; + FStar_Syntax_Syntax.injective_type_params1 = uu___6;_}; + FStar_Syntax_Syntax.sigrng = uu___7; + FStar_Syntax_Syntax.sigquals = uu___8; + FStar_Syntax_Syntax.sigmeta = uu___9; + FStar_Syntax_Syntax.sigattrs = uu___10; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; + FStar_Syntax_Syntax.sigopts = uu___12;_}, + uu___13), + uu___14) -> l | uu___1 -> let uu___2 = let uu___3 = FStar_Syntax_Print.lid_to_string lid in FStar_Compiler_Util.format1 "Not a datacon: %s" uu___3 in FStar_Compiler_Effect.failwith uu___2 -let (num_datacon_ty_params : +let (num_datacon_non_injective_ty_params : env -> FStar_Ident.lident -> Prims.int FStar_Pervasives_Native.option) = fun env1 -> fun lid -> @@ -3605,7 +3612,9 @@ let (num_datacon_ty_params : FStar_Syntax_Syntax.t1 = uu___3; FStar_Syntax_Syntax.ty_lid = uu___4; FStar_Syntax_Syntax.num_ty_params = num_ty_params; - FStar_Syntax_Syntax.mutuals1 = uu___5;_}; + FStar_Syntax_Syntax.mutuals1 = uu___5; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params;_}; FStar_Syntax_Syntax.sigrng = uu___6; FStar_Syntax_Syntax.sigquals = uu___7; FStar_Syntax_Syntax.sigmeta = uu___8; @@ -3614,7 +3623,10 @@ let (num_datacon_ty_params : FStar_Syntax_Syntax.sigopts = uu___11;_}, uu___12), uu___13) - -> FStar_Pervasives_Native.Some num_ty_params + -> + if injective_type_params + then FStar_Pervasives_Native.Some Prims.int_zero + else FStar_Pervasives_Native.Some num_ty_params | uu___1 -> FStar_Pervasives_Native.None let (lookup_definition_qninfo_aux : Prims.bool -> @@ -4431,15 +4443,16 @@ let (num_inductive_ty_params : FStar_Syntax_Syntax.num_uniform_params = uu___3; FStar_Syntax_Syntax.t = uu___4; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_}, - uu___13), - uu___14) + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_}, + uu___14), + uu___15) -> FStar_Pervasives_Native.Some (FStar_Compiler_List.length tps) | uu___1 -> FStar_Pervasives_Native.None let (num_inductive_uniform_ty_params : @@ -4459,27 +4472,28 @@ let (num_inductive_uniform_ty_params : FStar_Syntax_Syntax.num_uniform_params = num_uniform; FStar_Syntax_Syntax.t = uu___4; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_}, - uu___13), - uu___14) + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_}, + uu___14), + uu___15) -> (match num_uniform with | FStar_Pervasives_Native.None -> - let uu___15 = - let uu___16 = - let uu___17 = FStar_Ident.string_of_lid lid in + let uu___16 = + let uu___17 = + let uu___18 = FStar_Ident.string_of_lid lid in FStar_Compiler_Util.format1 "Internal error: Inductive %s is not decorated with its uniform type parameters" - uu___17 in - (FStar_Errors_Codes.Fatal_UnexpectedInductivetype, uu___16) in - let uu___16 = FStar_Ident.range_of_lid lid in - FStar_Errors.raise_error uu___15 uu___16 + uu___18 in + (FStar_Errors_Codes.Fatal_UnexpectedInductivetype, uu___17) in + let uu___17 = FStar_Ident.range_of_lid lid in + FStar_Errors.raise_error uu___16 uu___17 | FStar_Pervasives_Native.Some n -> FStar_Pervasives_Native.Some n) | uu___1 -> FStar_Pervasives_Native.None let (effect_decl_opt : diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml index c168df346fd..14b4af2363b 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml @@ -497,7 +497,8 @@ let rec (eq_t : else (); (let uu___2 = let uu___3 = FStar_Syntax_Syntax.lid_of_fv v1 in - FStar_TypeChecker_Env.num_datacon_ty_params env uu___3 in + FStar_TypeChecker_Env.num_datacon_non_injective_ty_params + env uu___3 in match uu___2 with | FStar_Pervasives_Native.None -> FStar_TypeChecker_TermEqAndSimplify.Unknown diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml index fbe5fb64f0a..e5e47469320 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml @@ -9005,7 +9005,8 @@ let rec (elim_uvars : FStar_Syntax_Syntax.params = binders; FStar_Syntax_Syntax.num_uniform_params = num_uniform; FStar_Syntax_Syntax.t = typ; FStar_Syntax_Syntax.mutuals = lids; - FStar_Syntax_Syntax.ds = lids';_} + FStar_Syntax_Syntax.ds = lids'; + FStar_Syntax_Syntax.injective_type_params = injective_type_params;_} -> let uu___ = elim_uvars_aux_t env1 univ_names binders typ in (match uu___ with @@ -9020,7 +9021,9 @@ let rec (elim_uvars : FStar_Syntax_Syntax.num_uniform_params = num_uniform; FStar_Syntax_Syntax.t = typ1; FStar_Syntax_Syntax.mutuals = lids; - FStar_Syntax_Syntax.ds = lids' + FStar_Syntax_Syntax.ds = lids'; + FStar_Syntax_Syntax.injective_type_params = + injective_type_params }); FStar_Syntax_Syntax.sigrng = (s1.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = @@ -9062,7 +9065,9 @@ let rec (elim_uvars : FStar_Syntax_Syntax.t1 = typ; FStar_Syntax_Syntax.ty_lid = lident; FStar_Syntax_Syntax.num_ty_params = i; - FStar_Syntax_Syntax.mutuals1 = lids;_} + FStar_Syntax_Syntax.mutuals1 = lids; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params;_} -> let uu___ = elim_uvars_aux_t env1 univ_names [] typ in (match uu___ with @@ -9076,7 +9081,9 @@ let rec (elim_uvars : FStar_Syntax_Syntax.t1 = typ1; FStar_Syntax_Syntax.ty_lid = lident; FStar_Syntax_Syntax.num_ty_params = i; - FStar_Syntax_Syntax.mutuals1 = lids + FStar_Syntax_Syntax.mutuals1 = lids; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params }); FStar_Syntax_Syntax.sigrng = (s1.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = @@ -9641,7 +9648,7 @@ let (get_n_binders : FStar_Syntax_Syntax.term -> (FStar_Syntax_Syntax.binder Prims.list * FStar_Syntax_Syntax.comp)) = fun env1 -> fun n -> fun t -> get_n_binders' env1 [] n t -let (uu___3792 : unit) = +let (uu___3794 : unit) = FStar_Compiler_Effect.op_Colon_Equals __get_n_binders get_n_binders' let (maybe_unfold_head_fv : FStar_TypeChecker_Env.env -> diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Positivity.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Positivity.ml index 797fe186c64..718a32b7f7d 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Positivity.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Positivity.ml @@ -138,10 +138,11 @@ let (open_sig_inductive_typ : FStar_Syntax_Syntax.num_uniform_params = uu___; FStar_Syntax_Syntax.t = uu___1; FStar_Syntax_Syntax.mutuals = uu___2; - FStar_Syntax_Syntax.ds = uu___3;_} + FStar_Syntax_Syntax.ds = uu___3; + FStar_Syntax_Syntax.injective_type_params = uu___4;_} -> - let uu___4 = FStar_Syntax_Subst.univ_var_opening ty_us in - (match uu___4 with + let uu___5 = FStar_Syntax_Subst.univ_var_opening ty_us in + (match uu___5 with | (ty_usubst, ty_us1) -> let env1 = FStar_TypeChecker_Env.push_univ_vars env ty_us1 in let ty_params1 = @@ -372,7 +373,9 @@ let (mark_uniform_type_parameters : FStar_Syntax_Syntax.num_uniform_params = uu___1; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = mutuals; - FStar_Syntax_Syntax.ds = data_lids;_} + FStar_Syntax_Syntax.ds = data_lids; + FStar_Syntax_Syntax.injective_type_params = + injective_type_params;_} -> let uu___2 = open_sig_inductive_typ env tc in (match uu___2 with @@ -390,31 +393,33 @@ let (mark_uniform_type_parameters : FStar_Syntax_Syntax.t1 = dt; FStar_Syntax_Syntax.ty_lid = tc_lid'; FStar_Syntax_Syntax.num_ty_params = uu___5; - FStar_Syntax_Syntax.mutuals1 = uu___6;_} + FStar_Syntax_Syntax.mutuals1 = uu___6; + FStar_Syntax_Syntax.injective_type_params1 + = uu___7;_} -> - let uu___7 = + let uu___8 = FStar_Ident.lid_equals tc_lid1 tc_lid' in - if uu___7 + if uu___8 then let dt1 = - let uu___8 = - let uu___9 = + let uu___9 = + let uu___10 = FStar_Compiler_List.map - (fun uu___10 -> + (fun uu___11 -> FStar_Syntax_Syntax.U_name - uu___10) us1 in + uu___11) us1 in FStar_TypeChecker_Env.mk_univ_subst - d_us uu___9 in - FStar_Syntax_Subst.subst uu___8 dt in - let uu___8 = - let uu___9 = - let uu___10 = + d_us uu___10 in + FStar_Syntax_Subst.subst uu___9 dt in + let uu___9 = + let uu___10 = + let uu___11 = apply_constr_arrow d_lid dt1 ty_param_args in FStar_Syntax_Util.arrow_formals - uu___10 in - FStar_Pervasives_Native.fst uu___9 in - FStar_Pervasives_Native.Some uu___8 + uu___11 in + FStar_Pervasives_Native.fst uu___10 in + FStar_Pervasives_Native.Some uu___9 else FStar_Pervasives_Native.None | uu___5 -> FStar_Pervasives_Native.None) datas in let ty_param_bvs = @@ -473,7 +478,9 @@ let (mark_uniform_type_parameters : max_uniform_prefix); FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = mutuals; - FStar_Syntax_Syntax.ds = data_lids + FStar_Syntax_Syntax.ds = data_lids; + FStar_Syntax_Syntax.injective_type_params = + injective_type_params } in { FStar_Syntax_Syntax.sigel = sigel; diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml index b0c708e79e5..bf80ad732b3 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml @@ -10,13 +10,15 @@ let (sigelt_typ : FStar_Syntax_Syntax.params = uu___2; FStar_Syntax_Syntax.num_uniform_params = uu___3; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> FStar_Pervasives_Native.Some t | FStar_Syntax_Syntax.Sig_datacon { FStar_Syntax_Syntax.lid1 = uu___; FStar_Syntax_Syntax.us1 = uu___1; FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_} + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> FStar_Pervasives_Native.Some t | FStar_Syntax_Syntax.Sig_declare_typ { FStar_Syntax_Syntax.lid2 = uu___; FStar_Syntax_Syntax.us2 = uu___1; @@ -435,7 +437,9 @@ let (tc_inductive' : uu___9; FStar_Syntax_Syntax.t = uu___10; FStar_Syntax_Syntax.mutuals = uu___11; - FStar_Syntax_Syntax.ds = uu___12;_} + FStar_Syntax_Syntax.ds = uu___12; + FStar_Syntax_Syntax.injective_type_params + = uu___13;_} -> (lid, (ty.FStar_Syntax_Syntax.sigrng)) | uu___7 -> FStar_Compiler_Effect.failwith @@ -464,7 +468,9 @@ let (tc_inductive' : FStar_Syntax_Syntax.t1 = uu___8; FStar_Syntax_Syntax.ty_lid = ty_lid; FStar_Syntax_Syntax.num_ty_params = uu___9; - FStar_Syntax_Syntax.mutuals1 = uu___10;_} + FStar_Syntax_Syntax.mutuals1 = uu___10; + FStar_Syntax_Syntax.injective_type_params1 + = uu___11;_} -> (data_lid, ty_lid) | uu___7 -> FStar_Compiler_Effect.failwith "Impossible" in @@ -506,7 +512,9 @@ let (tc_inductive' : uu___6; FStar_Syntax_Syntax.t = uu___7; FStar_Syntax_Syntax.mutuals = uu___8; - FStar_Syntax_Syntax.ds = uu___9;_} + FStar_Syntax_Syntax.ds = uu___9; + FStar_Syntax_Syntax.injective_type_params = + uu___10;_} -> lid1 | uu___4 -> FStar_Compiler_Effect.failwith "Impossible" in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml index 676e915c74f..ce84b3f0f05 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml @@ -5,6 +5,270 @@ let (unfold_whnf : = FStar_TypeChecker_Normalize.unfold_whnf' [FStar_TypeChecker_Env.AllowUnboundUniverses] +let (check_sig_inductive_injectivity_on_params : + FStar_TypeChecker_Env.env_t -> + FStar_Syntax_Syntax.sigelt -> FStar_Syntax_Syntax.sigelt) + = + fun tcenv -> + fun se -> + let uu___ = se.FStar_Syntax_Syntax.sigel in + match uu___ with + | FStar_Syntax_Syntax.Sig_inductive_typ dd -> + let uu___1 = dd in + (match uu___1 with + | { FStar_Syntax_Syntax.lid = t; + FStar_Syntax_Syntax.us = universe_names; + FStar_Syntax_Syntax.params = tps; + FStar_Syntax_Syntax.num_uniform_params = uu___2; + FStar_Syntax_Syntax.t = k; + FStar_Syntax_Syntax.mutuals = uu___3; + FStar_Syntax_Syntax.ds = uu___4; + FStar_Syntax_Syntax.injective_type_params = uu___5;_} -> + let t_lid = t in + let uu___6 = + FStar_Syntax_Subst.univ_var_opening universe_names in + (match uu___6 with + | (usubst, uvs) -> + let uu___7 = + let uu___8 = + FStar_TypeChecker_Env.push_univ_vars tcenv uvs in + let uu___9 = + FStar_Syntax_Subst.subst_binders usubst tps in + let uu___10 = + let uu___11 = + FStar_Syntax_Subst.shift_subst + (FStar_Compiler_List.length tps) usubst in + FStar_Syntax_Subst.subst uu___11 k in + (uu___8, uu___9, uu___10) in + (match uu___7 with + | (tcenv1, tps1, k1) -> + let uu___8 = FStar_Syntax_Subst.open_term tps1 k1 in + (match uu___8 with + | (tps2, k2) -> + let uu___9 = FStar_Syntax_Util.arrow_formals k2 in + (match uu___9 with + | (uu___10, k3) -> + let uu___11 = + FStar_TypeChecker_TcTerm.tc_binders + tcenv1 tps2 in + (match uu___11 with + | (tps3, env_tps, uu___12, us) -> + let u_k = + let uu___13 = + let uu___14 = + FStar_Syntax_Syntax.fvar t + FStar_Pervasives_Native.None in + let uu___15 = + let uu___16 = + FStar_Syntax_Util.args_of_binders + tps3 in + FStar_Pervasives_Native.snd + uu___16 in + let uu___16 = + FStar_Ident.range_of_lid t in + FStar_Syntax_Syntax.mk_Tm_app + uu___14 uu___15 uu___16 in + FStar_TypeChecker_TcTerm.level_of_type + env_tps uu___13 k3 in + let rec universe_leq u v = + match (u, v) with + | (FStar_Syntax_Syntax.U_zero, + uu___13) -> true + | (FStar_Syntax_Syntax.U_succ u0, + FStar_Syntax_Syntax.U_succ v0) + -> universe_leq u0 v0 + | (FStar_Syntax_Syntax.U_name u0, + FStar_Syntax_Syntax.U_name v0) + -> + FStar_Ident.ident_equals u0 v0 + | (FStar_Syntax_Syntax.U_name + uu___13, + FStar_Syntax_Syntax.U_succ v0) + -> universe_leq u v0 + | (FStar_Syntax_Syntax.U_max us1, + uu___13) -> + FStar_Compiler_Util.for_all + (fun u1 -> universe_leq u1 v) + us1 + | (uu___13, + FStar_Syntax_Syntax.U_max vs) -> + FStar_Compiler_Util.for_some + (universe_leq u) vs + | (FStar_Syntax_Syntax.U_unknown, + uu___13) -> + let uu___14 = + let uu___15 = + FStar_Ident.string_of_lid t in + let uu___16 = + FStar_Syntax_Print.univ_to_string + u in + let uu___17 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___15 uu___16 uu___17 in + FStar_Compiler_Effect.failwith + uu___14 + | (uu___13, + FStar_Syntax_Syntax.U_unknown) + -> + let uu___14 = + let uu___15 = + FStar_Ident.string_of_lid t in + let uu___16 = + FStar_Syntax_Print.univ_to_string + u in + let uu___17 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___15 uu___16 uu___17 in + FStar_Compiler_Effect.failwith + uu___14 + | (FStar_Syntax_Syntax.U_unif + uu___13, uu___14) -> + let uu___15 = + let uu___16 = + FStar_Ident.string_of_lid t in + let uu___17 = + FStar_Syntax_Print.univ_to_string + u in + let uu___18 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___16 uu___17 uu___18 in + FStar_Compiler_Effect.failwith + uu___15 + | (uu___13, + FStar_Syntax_Syntax.U_unif + uu___14) -> + let uu___15 = + let uu___16 = + FStar_Ident.string_of_lid t in + let uu___17 = + FStar_Syntax_Print.univ_to_string + u in + let uu___18 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___16 uu___17 uu___18 in + FStar_Compiler_Effect.failwith + uu___15 + | uu___13 -> false in + let u_leq_u_k u = + let u1 = + FStar_TypeChecker_Normalize.normalize_universe + env_tps u in + universe_leq u1 u_k in + let tp_ok tp u_tp = + let t_tp = + (tp.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in + let uu___13 = u_leq_u_k u_tp in + if uu___13 + then true + else + (let t_tp1 = + FStar_TypeChecker_Normalize.normalize + [FStar_TypeChecker_Env.Unrefine; + FStar_TypeChecker_Env.Unascribe; + FStar_TypeChecker_Env.Unmeta; + FStar_TypeChecker_Env.Primops; + FStar_TypeChecker_Env.HNF; + FStar_TypeChecker_Env.UnfoldUntil + FStar_Syntax_Syntax.delta_constant; + FStar_TypeChecker_Env.Beta] + env_tps t_tp in + let uu___15 = + FStar_Syntax_Util.arrow_formals + t_tp1 in + match uu___15 with + | (formals, t1) -> + let uu___16 = + FStar_TypeChecker_TcTerm.tc_binders + env_tps formals in + (match uu___16 with + | (uu___17, uu___18, + uu___19, u_formals) -> + let inj = + FStar_Compiler_Util.for_all + (fun u_formal -> + u_leq_u_k + u_formal) + u_formals in + if inj + then + let uu___20 = + let uu___21 = + FStar_Syntax_Subst.compress + t1 in + uu___21.FStar_Syntax_Syntax.n in + (match uu___20 with + | FStar_Syntax_Syntax.Tm_type + u -> u_leq_u_k u + | uu___21 -> false) + else false)) in + let injective_type_params = + FStar_Compiler_List.forall2 tp_ok + tps3 us in + ((let uu___14 = + FStar_TypeChecker_Env.debug + tcenv1 + (FStar_Options.Other + "TcInductive") in + if uu___14 + then + let uu___15 = + FStar_Ident.string_of_lid t in + FStar_Compiler_Util.print2 + "%s injectivity for %s\n" + (if injective_type_params + then "YES" + else "NO") uu___15 + else ()); + { + FStar_Syntax_Syntax.sigel = + (FStar_Syntax_Syntax.Sig_inductive_typ + { + FStar_Syntax_Syntax.lid = + (dd.FStar_Syntax_Syntax.lid); + FStar_Syntax_Syntax.us = + (dd.FStar_Syntax_Syntax.us); + FStar_Syntax_Syntax.params + = + (dd.FStar_Syntax_Syntax.params); + FStar_Syntax_Syntax.num_uniform_params + = + (dd.FStar_Syntax_Syntax.num_uniform_params); + FStar_Syntax_Syntax.t = + (dd.FStar_Syntax_Syntax.t); + FStar_Syntax_Syntax.mutuals + = + (dd.FStar_Syntax_Syntax.mutuals); + FStar_Syntax_Syntax.ds = + (dd.FStar_Syntax_Syntax.ds); + FStar_Syntax_Syntax.injective_type_params + = injective_type_params + }); + FStar_Syntax_Syntax.sigrng = + (se.FStar_Syntax_Syntax.sigrng); + FStar_Syntax_Syntax.sigquals = + (se.FStar_Syntax_Syntax.sigquals); + FStar_Syntax_Syntax.sigmeta = + (se.FStar_Syntax_Syntax.sigmeta); + FStar_Syntax_Syntax.sigattrs = + (se.FStar_Syntax_Syntax.sigattrs); + FStar_Syntax_Syntax.sigopens_and_abbrevs + = + (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); + FStar_Syntax_Syntax.sigopts = + (se.FStar_Syntax_Syntax.sigopts) + }))))))) let (tc_tycon : FStar_TypeChecker_Env.env_t -> FStar_Syntax_Syntax.sigelt -> @@ -19,36 +283,37 @@ let (tc_tycon : FStar_Syntax_Syntax.params = tps; FStar_Syntax_Syntax.num_uniform_params = n_uniform; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = mutuals; - FStar_Syntax_Syntax.ds = data;_} + FStar_Syntax_Syntax.ds = data; + FStar_Syntax_Syntax.injective_type_params = uu___;_} -> let env0 = env in - let uu___ = FStar_Syntax_Subst.univ_var_opening uvs in - (match uu___ with + let uu___1 = FStar_Syntax_Subst.univ_var_opening uvs in + (match uu___1 with | (usubst, uvs1) -> - let uu___1 = - let uu___2 = FStar_TypeChecker_Env.push_univ_vars env uvs1 in - let uu___3 = FStar_Syntax_Subst.subst_binders usubst tps in - let uu___4 = - let uu___5 = + let uu___2 = + let uu___3 = FStar_TypeChecker_Env.push_univ_vars env uvs1 in + let uu___4 = FStar_Syntax_Subst.subst_binders usubst tps in + let uu___5 = + let uu___6 = FStar_Syntax_Subst.shift_subst (FStar_Compiler_List.length tps) usubst in - FStar_Syntax_Subst.subst uu___5 k in - (uu___2, uu___3, uu___4) in - (match uu___1 with + FStar_Syntax_Subst.subst uu___6 k in + (uu___3, uu___4, uu___5) in + (match uu___2 with | (env1, tps1, k1) -> - let uu___2 = FStar_Syntax_Subst.open_term tps1 k1 in - (match uu___2 with + let uu___3 = FStar_Syntax_Subst.open_term tps1 k1 in + (match uu___3 with | (tps2, k2) -> - let uu___3 = + let uu___4 = FStar_TypeChecker_TcTerm.tc_binders env1 tps2 in - (match uu___3 with + (match uu___4 with | (tps3, env_tps, guard_params, us) -> - let uu___4 = - let uu___5 = + let uu___5 = + let uu___6 = FStar_TypeChecker_TcTerm.tc_tot_or_gtot_term env_tps k2 in - match uu___5 with - | (k3, uu___6, g) -> + match uu___6 with + | (k3, uu___7, g) -> let k4 = FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Env.Exclude @@ -60,23 +325,23 @@ let (tc_tycon : FStar_TypeChecker_Env.Exclude FStar_TypeChecker_Env.Beta] env_tps k3 in - let uu___7 = - FStar_Syntax_Util.arrow_formals k4 in let uu___8 = - let uu___9 = + FStar_Syntax_Util.arrow_formals k4 in + let uu___9 = + let uu___10 = FStar_TypeChecker_Env.conj_guard guard_params g in FStar_TypeChecker_Rel.discharge_guard - env_tps uu___9 in - (uu___7, uu___8) in - (match uu___4 with + env_tps uu___10 in + (uu___8, uu___9) in + (match uu___5 with | ((indices, t), guard) -> let k3 = - let uu___5 = + let uu___6 = FStar_Syntax_Syntax.mk_Total t in - FStar_Syntax_Util.arrow indices uu___5 in - let uu___5 = FStar_Syntax_Util.type_u () in - (match uu___5 with + FStar_Syntax_Util.arrow indices uu___6 in + let uu___6 = FStar_Syntax_Util.type_u () in + (match uu___6 with | (t_type, u) -> let valid_type = (((FStar_Syntax_Util.is_eqtype_no_unrefine @@ -96,21 +361,21 @@ let (tc_tycon : env1 t t_type) in (if Prims.op_Negation valid_type then - (let uu___7 = - let uu___8 = - let uu___9 = + (let uu___8 = + let uu___9 = + let uu___10 = FStar_Syntax_Print.term_to_string t in - let uu___10 = + let uu___11 = FStar_Ident.string_of_lid tc in FStar_Compiler_Util.format2 "Type annotation %s for inductive %s is not Type or eqtype, or it is eqtype but contains noeq/unopteq qualifiers" - uu___9 uu___10 in + uu___10 uu___11 in (FStar_Errors_Codes.Error_InductiveAnnotNotAType, - uu___8) in + uu___9) in FStar_Errors.raise_error_text - uu___7 + uu___8 s.FStar_Syntax_Syntax.sigrng) else (); (let usubst1 = @@ -120,22 +385,22 @@ let (tc_tycon : FStar_TypeChecker_Util.close_guard_implicits env1 false tps3 guard in let t_tc = - let uu___7 = - let uu___8 = + let uu___8 = + let uu___9 = FStar_Syntax_Subst.subst_binders usubst1 tps3 in - let uu___9 = - let uu___10 = + let uu___10 = + let uu___11 = FStar_Syntax_Subst.shift_subst (FStar_Compiler_List.length tps3) usubst1 in FStar_Syntax_Subst.subst_binders - uu___10 indices in + uu___11 indices in FStar_Compiler_List.op_At - uu___8 uu___9 in - let uu___8 = - let uu___9 = - let uu___10 = + uu___9 uu___10 in + let uu___9 = + let uu___10 = + let uu___11 = FStar_Syntax_Subst.shift_subst ((FStar_Compiler_List.length tps3) @@ -143,46 +408,46 @@ let (tc_tycon : (FStar_Compiler_List.length indices)) usubst1 in FStar_Syntax_Subst.subst - uu___10 t in + uu___11 t in FStar_Syntax_Syntax.mk_Total - uu___9 in - FStar_Syntax_Util.arrow uu___7 - uu___8 in + uu___10 in + FStar_Syntax_Util.arrow uu___8 + uu___9 in let tps4 = FStar_Syntax_Subst.close_binders tps3 in let k4 = FStar_Syntax_Subst.close tps4 k3 in - let uu___7 = - let uu___8 = + let uu___8 = + let uu___9 = FStar_Syntax_Subst.subst_binders usubst1 tps4 in - let uu___9 = - let uu___10 = + let uu___10 = + let uu___11 = FStar_Syntax_Subst.shift_subst (FStar_Compiler_List.length tps4) usubst1 in FStar_Syntax_Subst.subst - uu___10 k4 in - (uu___8, uu___9) in - match uu___7 with + uu___11 k4 in + (uu___9, uu___10) in + match uu___8 with | (tps5, k5) -> let fv_tc = FStar_Syntax_Syntax.lid_as_fv tc FStar_Pervasives_Native.None in - let uu___8 = + let uu___9 = FStar_Syntax_Subst.open_univ_vars uvs1 t_tc in - (match uu___8 with + (match uu___9 with | (uvs2, t_tc1) -> - let uu___9 = + let uu___10 = FStar_TypeChecker_Env.push_let_binding env0 (FStar_Pervasives.Inr fv_tc) (uvs2, t_tc1) in - (uu___9, + (uu___10, { FStar_Syntax_Syntax.sigel = @@ -201,7 +466,9 @@ let (tc_tycon : FStar_Syntax_Syntax.mutuals = mutuals; FStar_Syntax_Syntax.ds - = data + = data; + FStar_Syntax_Syntax.injective_type_params + = false }); FStar_Syntax_Syntax.sigrng = @@ -245,47 +512,50 @@ let (tc_data : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = tc_lid; FStar_Syntax_Syntax.num_ty_params = ntps; - FStar_Syntax_Syntax.mutuals1 = mutual_tcs;_} + FStar_Syntax_Syntax.mutuals1 = mutual_tcs; + FStar_Syntax_Syntax.injective_type_params1 = uu___;_} -> - let uu___ = FStar_Syntax_Subst.univ_var_opening _uvs in - (match uu___ with + let uu___1 = FStar_Syntax_Subst.univ_var_opening _uvs in + (match uu___1 with | (usubst, _uvs1) -> - let uu___1 = - let uu___2 = + let uu___2 = + let uu___3 = FStar_TypeChecker_Env.push_univ_vars env _uvs1 in - let uu___3 = FStar_Syntax_Subst.subst usubst t in - (uu___2, uu___3) in - (match uu___1 with + let uu___4 = FStar_Syntax_Subst.subst usubst t in + (uu___3, uu___4) in + (match uu___2 with | (env1, t1) -> - let uu___2 = + let uu___3 = let tps_u_opt = FStar_Compiler_Util.find_map tcs - (fun uu___3 -> - match uu___3 with + (fun uu___4 -> + match uu___4 with | (se1, u_tc) -> - let uu___4 = - let uu___5 = - let uu___6 = + let uu___5 = + let uu___6 = + let uu___7 = FStar_Syntax_Util.lid_of_sigelt se1 in - FStar_Compiler_Util.must uu___6 in - FStar_Ident.lid_equals tc_lid uu___5 in - if uu___4 + FStar_Compiler_Util.must uu___7 in + FStar_Ident.lid_equals tc_lid uu___6 in + if uu___5 then (match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_inductive_typ - { FStar_Syntax_Syntax.lid = uu___5; - FStar_Syntax_Syntax.us = uu___6; + { FStar_Syntax_Syntax.lid = uu___6; + FStar_Syntax_Syntax.us = uu___7; FStar_Syntax_Syntax.params = tps; FStar_Syntax_Syntax.num_uniform_params - = uu___7; - FStar_Syntax_Syntax.t = uu___8; + = uu___8; + FStar_Syntax_Syntax.t = uu___9; FStar_Syntax_Syntax.mutuals = - uu___9; - FStar_Syntax_Syntax.ds = uu___10;_} + uu___10; + FStar_Syntax_Syntax.ds = uu___11; + FStar_Syntax_Syntax.injective_type_params + = uu___12;_} -> let tps1 = - let uu___11 = + let uu___13 = FStar_Syntax_Subst.subst_binders usubst tps in FStar_Compiler_List.map @@ -304,37 +574,37 @@ let (tc_data : FStar_Syntax_Syntax.binder_attrs = (x.FStar_Syntax_Syntax.binder_attrs) - }) uu___11 in + }) uu___13 in let tps2 = FStar_Syntax_Subst.open_binders tps1 in - let uu___11 = - let uu___12 = + let uu___13 = + let uu___14 = FStar_TypeChecker_Env.push_binders env1 tps2 in - (uu___12, tps2, u_tc) in + (uu___14, tps2, u_tc) in FStar_Pervasives_Native.Some - uu___11 - | uu___5 -> + uu___13 + | uu___6 -> FStar_Compiler_Effect.failwith "Impossible") else FStar_Pervasives_Native.None) in match tps_u_opt with | FStar_Pervasives_Native.Some x -> x | FStar_Pervasives_Native.None -> - let uu___3 = + let uu___4 = FStar_Ident.lid_equals tc_lid FStar_Parser_Const.exn_lid in - if uu___3 + if uu___4 then (env1, [], FStar_Syntax_Syntax.U_zero) else FStar_Errors.raise_error (FStar_Errors_Codes.Fatal_UnexpectedDataConstructor, "Unexpected data constructor") se.FStar_Syntax_Syntax.sigrng in - (match uu___2 with + (match uu___3 with | (env2, tps, u_tc) -> - let uu___3 = + let uu___4 = let t2 = FStar_TypeChecker_Normalize.normalize (FStar_Compiler_List.op_At @@ -342,18 +612,18 @@ let (tc_data : [FStar_TypeChecker_Env.AllowUnboundUniverses]) env2 t1 in let t3 = FStar_Syntax_Util.canon_arrow t2 in - let uu___4 = - let uu___5 = FStar_Syntax_Subst.compress t3 in - uu___5.FStar_Syntax_Syntax.n in - match uu___4 with + let uu___5 = + let uu___6 = FStar_Syntax_Subst.compress t3 in + uu___6.FStar_Syntax_Syntax.n in + match uu___5 with | FStar_Syntax_Syntax.Tm_arrow { FStar_Syntax_Syntax.bs1 = bs; FStar_Syntax_Syntax.comp = res;_} -> - let uu___5 = + let uu___6 = FStar_Compiler_Util.first_N ntps bs in - (match uu___5 with - | (uu___6, bs') -> + (match uu___6 with + | (uu___7, bs') -> let t4 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_arrow @@ -364,71 +634,71 @@ let (tc_data : let subst = FStar_Compiler_List.mapi (fun i -> - fun uu___7 -> - match uu___7 with + fun uu___8 -> + match uu___8 with | { FStar_Syntax_Syntax.binder_bv = x; FStar_Syntax_Syntax.binder_qual - = uu___8; - FStar_Syntax_Syntax.binder_positivity = uu___9; + FStar_Syntax_Syntax.binder_positivity + = uu___10; FStar_Syntax_Syntax.binder_attrs - = uu___10;_} + = uu___11;_} -> FStar_Syntax_Syntax.DB ((ntps - (Prims.int_one + i)), x)) tps in - let uu___7 = - let uu___8 = + let uu___8 = + let uu___9 = FStar_Syntax_Subst.subst subst t4 in FStar_Syntax_Util.arrow_formals_comp - uu___8 in - (match uu___7 with + uu___9 in + (match uu___8 with | (bs1, c1) -> - let uu___8 = + let uu___9 = (FStar_Options.ml_ish ()) || (FStar_Syntax_Util.is_total_comp c1) in - if uu___8 + if uu___9 then (bs1, (FStar_Syntax_Util.comp_result c1)) else - (let uu___10 = + (let uu___11 = FStar_Ident.range_of_lid (FStar_Syntax_Util.comp_effect_name c1) in FStar_Errors.raise_error (FStar_Errors_Codes.Fatal_UnexpectedConstructorType, "Constructors cannot have effects") - uu___10))) - | uu___5 -> ([], t3) in - (match uu___3 with + uu___11))) + | uu___6 -> ([], t3) in + (match uu___4 with | (arguments, result) -> - ((let uu___5 = + ((let uu___6 = FStar_TypeChecker_Env.debug env2 FStar_Options.Low in - if uu___5 + if uu___6 then - let uu___6 = - FStar_Syntax_Print.lid_to_string c in let uu___7 = + FStar_Syntax_Print.lid_to_string c in + let uu___8 = FStar_Syntax_Print.binders_to_string "->" arguments in - let uu___8 = + let uu___9 = FStar_Syntax_Print.term_to_string result in FStar_Compiler_Util.print3 "Checking datacon %s : %s -> %s \n" - uu___6 uu___7 uu___8 + uu___7 uu___8 uu___9 else ()); - (let uu___5 = + (let uu___6 = FStar_TypeChecker_TcTerm.tc_tparams env2 arguments in - match uu___5 with + match uu___6 with | (arguments1, env', us) -> let type_u_tc = FStar_Syntax_Syntax.mk @@ -437,23 +707,23 @@ let (tc_data : let env'1 = FStar_TypeChecker_Env.set_expected_typ env' type_u_tc in - let uu___6 = + let uu___7 = FStar_TypeChecker_TcTerm.tc_trivial_guard env'1 result in - (match uu___6 with + (match uu___7 with | (result1, res_lcomp) -> - let uu___7 = + let uu___8 = FStar_Syntax_Util.head_and_args_full result1 in - (match uu___7 with + (match uu___8 with | (head, args) -> let g_uvs = - let uu___8 = - let uu___9 = + let uu___9 = + let uu___10 = FStar_Syntax_Subst.compress head in - uu___9.FStar_Syntax_Syntax.n in - match uu___8 with + uu___10.FStar_Syntax_Syntax.n in + match uu___9 with | FStar_Syntax_Syntax.Tm_uinst ({ FStar_Syntax_Syntax.n @@ -461,11 +731,11 @@ let (tc_data : FStar_Syntax_Syntax.Tm_fvar fv; FStar_Syntax_Syntax.pos - = uu___9; - FStar_Syntax_Syntax.vars = uu___10; + FStar_Syntax_Syntax.vars + = uu___11; FStar_Syntax_Syntax.hash_code - = uu___11;_}, + = uu___12;_}, tuvs) when FStar_Syntax_Syntax.fv_eq_lid @@ -482,15 +752,15 @@ let (tc_data : (fun g -> fun u1 -> fun u2 -> - let uu___12 + let uu___13 = - let uu___13 + let uu___14 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_type u1) FStar_Compiler_Range_Type.dummyRange in - let uu___14 + let uu___15 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_type @@ -499,10 +769,10 @@ let (tc_data : FStar_Compiler_Range_Type.dummyRange in FStar_TypeChecker_Rel.teq env'1 - uu___13 - uu___14 in + uu___14 + uu___15 in FStar_TypeChecker_Env.conj_guard - g uu___12) + g uu___13) FStar_TypeChecker_Env.trivial_guard tuvs _uvs1 else @@ -516,138 +786,138 @@ let (tc_data : fv tc_lid -> FStar_TypeChecker_Env.trivial_guard - | uu___9 -> - let uu___10 = - let uu___11 = - let uu___12 = + | uu___10 -> + let uu___11 = + let uu___12 = + let uu___13 = FStar_Syntax_Print.lid_to_string tc_lid in - let uu___13 = + let uu___14 = FStar_Syntax_Print.term_to_string head in FStar_Compiler_Util.format2 "Expected a constructor of type %s; got %s" - uu___12 uu___13 in + uu___13 uu___14 in (FStar_Errors_Codes.Fatal_UnexpectedConstructorType, - uu___11) in + uu___12) in FStar_Errors.raise_error - uu___10 + uu___11 se.FStar_Syntax_Syntax.sigrng in let g = FStar_Compiler_List.fold_left2 (fun g1 -> - fun uu___8 -> + fun uu___9 -> fun u_x -> - match uu___8 with + match uu___9 with | { FStar_Syntax_Syntax.binder_bv = x; FStar_Syntax_Syntax.binder_qual - = uu___9; - FStar_Syntax_Syntax.binder_positivity = uu___10; + FStar_Syntax_Syntax.binder_positivity + = uu___11; FStar_Syntax_Syntax.binder_attrs - = uu___11;_} + = uu___12;_} -> - let uu___12 = + let uu___13 = FStar_TypeChecker_Rel.universe_inequality u_x u_tc in FStar_TypeChecker_Env.conj_guard - g1 uu___12) + g1 uu___13) g_uvs arguments1 us in (FStar_Errors.stop_if_err (); (let p_args = - let uu___9 = + let uu___10 = FStar_Compiler_Util.first_N (FStar_Compiler_List.length tps) args in FStar_Pervasives_Native.fst - uu___9 in + uu___10 in FStar_Compiler_List.iter2 - (fun uu___10 -> - fun uu___11 -> - match (uu___10, - uu___11) + (fun uu___11 -> + fun uu___12 -> + match (uu___11, + uu___12) with | ({ FStar_Syntax_Syntax.binder_bv = bv; FStar_Syntax_Syntax.binder_qual - = uu___12; - FStar_Syntax_Syntax.binder_positivity = uu___13; + FStar_Syntax_Syntax.binder_positivity + = uu___14; FStar_Syntax_Syntax.binder_attrs - = uu___14;_}, - (t2, uu___15)) -> - let uu___16 = - let uu___17 = + = uu___15;_}, + (t2, uu___16)) -> + let uu___17 = + let uu___18 = FStar_Syntax_Subst.compress t2 in - uu___17.FStar_Syntax_Syntax.n in - (match uu___16 + uu___18.FStar_Syntax_Syntax.n in + (match uu___17 with | FStar_Syntax_Syntax.Tm_name bv' when FStar_Syntax_Syntax.bv_eq bv bv' -> () - | uu___17 -> - let uu___18 - = - let uu___19 + | uu___18 -> + let uu___19 = let uu___20 = + let uu___21 + = FStar_Syntax_Print.bv_to_string bv in - let uu___21 + let uu___22 = FStar_Syntax_Print.term_to_string t2 in FStar_Compiler_Util.format2 "This parameter is not constant: expected %s, got %s" - uu___20 - uu___21 in + uu___21 + uu___22 in (FStar_Errors_Codes.Error_BadInductiveParam, - uu___19) in + uu___20) in FStar_Errors.raise_error - uu___18 + uu___19 t2.FStar_Syntax_Syntax.pos)) tps p_args; (let ty = - let uu___10 = + let uu___11 = unfold_whnf env2 res_lcomp.FStar_TypeChecker_Common.res_typ in FStar_Syntax_Util.unrefine - uu___10 in - (let uu___11 = - let uu___12 = + uu___11 in + (let uu___12 = + let uu___13 = FStar_Syntax_Subst.compress ty in - uu___12.FStar_Syntax_Syntax.n in - match uu___11 with + uu___13.FStar_Syntax_Syntax.n in + match uu___12 with | FStar_Syntax_Syntax.Tm_type - uu___12 -> () - | uu___12 -> - let uu___13 = - let uu___14 = - let uu___15 = + uu___13 -> () + | uu___13 -> + let uu___14 = + let uu___15 = + let uu___16 = FStar_Syntax_Print.term_to_string result1 in - let uu___16 = + let uu___17 = FStar_Syntax_Print.term_to_string ty in FStar_Compiler_Util.format2 "The type of %s is %s, but since this is the result type of a constructor its type should be Type" - uu___15 uu___16 in + uu___16 uu___17 in (FStar_Errors_Codes.Fatal_WrongResultTypeAfterConstrutor, - uu___14) in + uu___15) in FStar_Errors.raise_error - uu___13 + uu___14 se.FStar_Syntax_Syntax.sigrng); (let t2 = - let uu___11 = - let uu___12 = + let uu___12 = + let uu___13 = FStar_Compiler_List.map (fun b -> { @@ -667,12 +937,12 @@ let (tc_data : (b.FStar_Syntax_Syntax.binder_attrs) }) tps in FStar_Compiler_List.op_At - uu___12 arguments1 in - let uu___12 = + uu___13 arguments1 in + let uu___13 = FStar_Syntax_Syntax.mk_Total result1 in FStar_Syntax_Util.arrow - uu___11 uu___12 in + uu___12 uu___13 in let t3 = FStar_Syntax_Subst.close_univ_vars _uvs1 t2 in @@ -692,7 +962,9 @@ let (tc_data : FStar_Syntax_Syntax.num_ty_params = ntps; FStar_Syntax_Syntax.mutuals1 - = mutual_tcs + = mutual_tcs; + FStar_Syntax_Syntax.injective_type_params1 + = false }); FStar_Syntax_Syntax.sigrng = @@ -737,12 +1009,13 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.num_uniform_params = uu___4; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_} + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_} -> - let uu___7 = - let uu___8 = FStar_Syntax_Syntax.mk_Total k in - FStar_Syntax_Util.arrow tps uu___8 in - FStar_Syntax_Syntax.null_binder uu___7 + let uu___8 = + let uu___9 = FStar_Syntax_Syntax.mk_Total k in + FStar_Syntax_Util.arrow tps uu___9 in + FStar_Syntax_Syntax.null_binder uu___8 | uu___2 -> FStar_Compiler_Effect.failwith "Impossible")) tcs in let binders' = @@ -755,7 +1028,8 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_} + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> FStar_Syntax_Syntax.null_binder t | uu___ -> FStar_Compiler_Effect.failwith "Impossible") datas in let t = @@ -828,19 +1102,21 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.mutuals = mutuals; FStar_Syntax_Syntax.ds = - datas1;_} + datas1; + FStar_Syntax_Syntax.injective_type_params + = uu___15;_} -> let ty = FStar_Syntax_Subst.close_univ_vars uvs1 x.FStar_Syntax_Syntax.sort in - let uu___15 = - let uu___16 = - let uu___17 = + let uu___16 = + let uu___17 = + let uu___18 = FStar_Syntax_Subst.compress ty in - uu___17.FStar_Syntax_Syntax.n in - match uu___16 with + uu___18.FStar_Syntax_Syntax.n in + match uu___17 with | FStar_Syntax_Syntax.Tm_arrow { FStar_Syntax_Syntax.bs1 @@ -848,18 +1124,18 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.comp = c;_} -> - let uu___17 = + let uu___18 = FStar_Compiler_Util.first_N (FStar_Compiler_List.length tps) binders1 in - (match uu___17 with + (match uu___18 with | (tps1, rest) -> let t3 = match rest with | [] -> FStar_Syntax_Util.comp_result c - | uu___18 -> + | uu___19 -> FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_arrow { @@ -870,8 +1146,8 @@ let (generalize_and_inst_within : }) (x.FStar_Syntax_Syntax.sort).FStar_Syntax_Syntax.pos in (tps1, t3)) - | uu___17 -> ([], ty) in - (match uu___15 with + | uu___18 -> ([], ty) in + (match uu___16 with | (tps1, t3) -> { FStar_Syntax_Syntax.sigel @@ -891,7 +1167,9 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.mutuals = mutuals; FStar_Syntax_Syntax.ds - = datas1 + = datas1; + FStar_Syntax_Syntax.injective_type_params + = false }); FStar_Syntax_Syntax.sigrng = @@ -945,19 +1223,21 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.mutuals = uu___13; FStar_Syntax_Syntax.ds = - uu___14;_}; + uu___14; + FStar_Syntax_Syntax.injective_type_params + = uu___15;_}; FStar_Syntax_Syntax.sigrng = - uu___15; - FStar_Syntax_Syntax.sigquals = uu___16; - FStar_Syntax_Syntax.sigmeta = + FStar_Syntax_Syntax.sigquals = uu___17; - FStar_Syntax_Syntax.sigattrs = + FStar_Syntax_Syntax.sigmeta = uu___18; + FStar_Syntax_Syntax.sigattrs = + uu___19; FStar_Syntax_Syntax.sigopens_and_abbrevs - = uu___19; + = uu___20; FStar_Syntax_Syntax.sigopts = - uu___20;_} + uu___21;_} -> (tc, uvs_universes) | uu___9 -> FStar_Compiler_Effect.failwith @@ -991,15 +1271,17 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.num_ty_params = ntps; FStar_Syntax_Syntax.mutuals1 - = mutuals;_} + = mutuals; + FStar_Syntax_Syntax.injective_type_params1 + = uu___14;_} -> let ty = - let uu___14 = + let uu___15 = FStar_Syntax_InstFV.instantiate tc_insts t3.FStar_Syntax_Syntax.sort in FStar_Syntax_Subst.close_univ_vars - uvs1 uu___14 in + uvs1 uu___15 in { FStar_Syntax_Syntax.sigel = @@ -1016,7 +1298,9 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.num_ty_params = ntps; FStar_Syntax_Syntax.mutuals1 - = mutuals + = mutuals; + FStar_Syntax_Syntax.injective_type_params1 + = false }); FStar_Syntax_Syntax.sigrng = @@ -1049,7 +1333,8 @@ let (datacon_typ : FStar_Syntax_Syntax.sigelt -> FStar_Syntax_Syntax.term) = { FStar_Syntax_Syntax.lid1 = uu___; FStar_Syntax_Syntax.us1 = uu___1; FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_} + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> t | uu___ -> FStar_Compiler_Effect.failwith "Impossible!" let (haseq_suffix : Prims.string) = "__uu___haseq" @@ -1102,7 +1387,8 @@ let (get_optimized_haseq_axiom : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = uu___3; - FStar_Syntax_Syntax.ds = uu___4;_} + FStar_Syntax_Syntax.ds = uu___4; + FStar_Syntax_Syntax.injective_type_params = uu___5;_} -> (lid, bs, t) | uu___1 -> FStar_Compiler_Effect.failwith "Impossible!" in match uu___ with @@ -1359,7 +1645,8 @@ let (optimized_haseq_ty : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = uu___3; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> lid1 | uu___ -> FStar_Compiler_Effect.failwith "Impossible!" in let uu___ = acc in @@ -1387,7 +1674,9 @@ let (optimized_haseq_ty : FStar_Syntax_Syntax.ty_lid = t_lid; FStar_Syntax_Syntax.num_ty_params = uu___9; - FStar_Syntax_Syntax.mutuals1 = uu___10;_} + FStar_Syntax_Syntax.mutuals1 = uu___10; + FStar_Syntax_Syntax.injective_type_params1 + = uu___11;_} -> t_lid = lid | uu___6 -> FStar_Compiler_Effect.failwith @@ -1425,7 +1714,8 @@ let (optimized_haseq_scheme : FStar_Syntax_Syntax.num_uniform_params = uu___3; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> (us, t) | uu___1 -> FStar_Compiler_Effect.failwith "Impossible!" in match uu___ with @@ -1652,7 +1942,8 @@ let (unoptimized_haseq_ty : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = uu___3; - FStar_Syntax_Syntax.ds = d_lids;_} + FStar_Syntax_Syntax.ds = d_lids; + FStar_Syntax_Syntax.injective_type_params = uu___4;_} -> (lid, bs, t, d_lids) | uu___1 -> FStar_Compiler_Effect.failwith "Impossible!" in match uu___ with @@ -1715,7 +2006,9 @@ let (unoptimized_haseq_ty : FStar_Syntax_Syntax.ty_lid = t_lid; FStar_Syntax_Syntax.num_ty_params = uu___5; - FStar_Syntax_Syntax.mutuals1 = uu___6;_} + FStar_Syntax_Syntax.mutuals1 = uu___6; + FStar_Syntax_Syntax.injective_type_params1 + = uu___7;_} -> t_lid = lid | uu___2 -> FStar_Compiler_Effect.failwith "Impossible") @@ -1820,7 +2113,8 @@ let (unoptimized_haseq_scheme : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = uu___3; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> lid | uu___ -> FStar_Compiler_Effect.failwith "Impossible!") tcs in let uu___ = @@ -1832,7 +2126,8 @@ let (unoptimized_haseq_scheme : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = uu___3; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> (lid, us) | uu___1 -> FStar_Compiler_Effect.failwith "Impossible!" in match uu___ with @@ -1933,7 +2228,9 @@ let (check_inductive_well_typedness : FStar_Syntax_Syntax.num_uniform_params = uu___6; FStar_Syntax_Syntax.t = uu___7; FStar_Syntax_Syntax.mutuals = uu___8; - FStar_Syntax_Syntax.ds = uu___9;_} + FStar_Syntax_Syntax.ds = uu___9; + FStar_Syntax_Syntax.injective_type_params = + uu___10;_} -> uvs | uu___4 -> FStar_Compiler_Effect.failwith @@ -2045,49 +2342,51 @@ let (check_inductive_well_typedness : = num_uniform; FStar_Syntax_Syntax.t = typ; FStar_Syntax_Syntax.mutuals = ts; - FStar_Syntax_Syntax.ds = ds;_} + FStar_Syntax_Syntax.ds = ds; + FStar_Syntax_Syntax.injective_type_params + = uu___5;_} -> let fail expected inferred = - let uu___5 = - let uu___6 = - let uu___7 = + let uu___6 = + let uu___7 = + let uu___8 = FStar_Syntax_Print.tscheme_to_string expected in - let uu___8 = + let uu___9 = FStar_Syntax_Print.tscheme_to_string inferred in FStar_Compiler_Util.format2 "Expected an inductive with type %s; got %s" - uu___7 uu___8 in + uu___8 uu___9 in (FStar_Errors_Codes.Fatal_UnexpectedInductivetype, - uu___6) in - FStar_Errors.raise_error uu___5 + uu___7) in + FStar_Errors.raise_error uu___6 se.FStar_Syntax_Syntax.sigrng in let copy_binder_attrs_from_val binders1 expected = let expected_attrs = - let uu___5 = - let uu___6 = + let uu___6 = + let uu___7 = FStar_TypeChecker_Normalize.get_n_binders env1 (FStar_Compiler_List.length binders1) expected in FStar_Pervasives_Native.fst - uu___6 in + uu___7 in FStar_Compiler_List.map - (fun uu___6 -> - match uu___6 with + (fun uu___7 -> + match uu___7 with | { FStar_Syntax_Syntax.binder_bv - = uu___7; - FStar_Syntax_Syntax.binder_qual = uu___8; + FStar_Syntax_Syntax.binder_qual + = uu___9; FStar_Syntax_Syntax.binder_positivity = pqual; FStar_Syntax_Syntax.binder_attrs = attrs;_} -> (attrs, pqual)) - uu___5 in + uu___6 in if (FStar_Compiler_List.length expected_attrs) @@ -2095,44 +2394,44 @@ let (check_inductive_well_typedness : (FStar_Compiler_List.length binders1) then - let uu___5 = - let uu___6 = - let uu___7 = + let uu___6 = + let uu___7 = + let uu___8 = FStar_Compiler_Util.string_of_int (FStar_Compiler_List.length binders1) in - let uu___8 = + let uu___9 = FStar_Syntax_Print.term_to_string expected in FStar_Compiler_Util.format2 "Could not get %s type parameters from val type %s" - uu___7 uu___8 in + uu___8 uu___9 in (FStar_Errors_Codes.Fatal_UnexpectedInductivetype, - uu___6) in - FStar_Errors.raise_error uu___5 + uu___7) in + FStar_Errors.raise_error uu___6 se.FStar_Syntax_Syntax.sigrng else FStar_Compiler_List.map2 - (fun uu___6 -> + (fun uu___7 -> fun b -> - match uu___6 with + match uu___7 with | (ex_attrs, pqual) -> - ((let uu___8 = - let uu___9 = + ((let uu___9 = + let uu___10 = FStar_TypeChecker_Common.check_positivity_qual true pqual b.FStar_Syntax_Syntax.binder_positivity in Prims.op_Negation - uu___9 in - if uu___8 + uu___10 in + if uu___9 then - let uu___9 = + let uu___10 = FStar_Syntax_Syntax.range_of_bv b.FStar_Syntax_Syntax.binder_bv in FStar_Errors.raise_error (FStar_Errors_Codes.Fatal_UnexpectedInductivetype, "Incompatible positivity annotation") - uu___9 + uu___10 else ()); { FStar_Syntax_Syntax.binder_bv @@ -2155,32 +2454,32 @@ let (check_inductive_well_typedness : let body = match binders1 with | [] -> typ - | uu___5 -> - let uu___6 = - let uu___7 = - let uu___8 = + | uu___6 -> + let uu___7 = + let uu___8 = + let uu___9 = FStar_Syntax_Syntax.mk_Total typ in { FStar_Syntax_Syntax.bs1 = binders1; FStar_Syntax_Syntax.comp - = uu___8 + = uu___9 } in FStar_Syntax_Syntax.Tm_arrow - uu___7 in + uu___8 in FStar_Syntax_Syntax.mk - uu___6 + uu___7 se.FStar_Syntax_Syntax.sigrng in (univs1, body) in - let uu___5 = + let uu___6 = FStar_TypeChecker_Env.try_lookup_val_decl env0 l in - (match uu___5 with + (match uu___6 with | FStar_Pervasives_Native.None -> se | FStar_Pervasives_Native.Some - (expected_typ, uu___6) -> + (expected_typ, uu___7) -> if (FStar_Compiler_List.length univs1) @@ -2189,32 +2488,32 @@ let (check_inductive_well_typedness : (FStar_Pervasives_Native.fst expected_typ)) then - let uu___7 = + let uu___8 = FStar_Syntax_Subst.open_univ_vars univs1 (FStar_Pervasives_Native.snd expected_typ) in - (match uu___7 with - | (uu___8, expected) -> + (match uu___8 with + | (uu___9, expected) -> let binders1 = copy_binder_attrs_from_val binders expected in let inferred_typ = inferred_typ_with_binders binders1 in - let uu___9 = + let uu___10 = FStar_Syntax_Subst.open_univ_vars univs1 (FStar_Pervasives_Native.snd inferred_typ) in - (match uu___9 with - | (uu___10, inferred) + (match uu___10 with + | (uu___11, inferred) -> - let uu___11 = + let uu___12 = FStar_TypeChecker_Rel.teq_nosmt_force env0 inferred expected in - if uu___11 + if uu___12 then { FStar_Syntax_Syntax.sigel @@ -2236,7 +2535,9 @@ let (check_inductive_well_typedness : FStar_Syntax_Syntax.mutuals = ts; FStar_Syntax_Syntax.ds - = ds + = ds; + FStar_Syntax_Syntax.injective_type_params + = false }); FStar_Syntax_Syntax.sigrng = @@ -2261,11 +2562,94 @@ let (check_inductive_well_typedness : fail expected_typ inferred_typ)) else - (let uu___8 = + (let uu___9 = inferred_typ_with_binders binders in - fail expected_typ uu___8)) + fail expected_typ uu___9)) | uu___5 -> se) tcs1 in + let tcs3 = + FStar_Compiler_List.map + (check_sig_inductive_injectivity_on_params + env1) tcs2 in + let is_injective l = + let uu___5 = + FStar_Compiler_List.tryPick + (fun se -> + let uu___6 = + se.FStar_Syntax_Syntax.sigel in + match uu___6 with + | FStar_Syntax_Syntax.Sig_inductive_typ + { FStar_Syntax_Syntax.lid = lid; + FStar_Syntax_Syntax.us = uu___7; + FStar_Syntax_Syntax.params = + uu___8; + FStar_Syntax_Syntax.num_uniform_params + = uu___9; + FStar_Syntax_Syntax.t = uu___10; + FStar_Syntax_Syntax.mutuals = + uu___11; + FStar_Syntax_Syntax.ds = uu___12; + FStar_Syntax_Syntax.injective_type_params + = injective_type_params;_} + -> + let uu___13 = + FStar_Ident.lid_equals l lid in + if uu___13 + then + FStar_Pervasives_Native.Some + injective_type_params + else FStar_Pervasives_Native.None) + tcs3 in + match uu___5 with + | FStar_Pervasives_Native.None -> false + | FStar_Pervasives_Native.Some i -> i in + let datas3 = + FStar_Compiler_List.map + (fun se -> + let uu___5 = + se.FStar_Syntax_Syntax.sigel in + match uu___5 with + | FStar_Syntax_Syntax.Sig_datacon dd -> + let uu___6 = + let uu___7 = + let uu___8 = + is_injective + dd.FStar_Syntax_Syntax.ty_lid in + { + FStar_Syntax_Syntax.lid1 = + (dd.FStar_Syntax_Syntax.lid1); + FStar_Syntax_Syntax.us1 = + (dd.FStar_Syntax_Syntax.us1); + FStar_Syntax_Syntax.t1 = + (dd.FStar_Syntax_Syntax.t1); + FStar_Syntax_Syntax.ty_lid = + (dd.FStar_Syntax_Syntax.ty_lid); + FStar_Syntax_Syntax.num_ty_params + = + (dd.FStar_Syntax_Syntax.num_ty_params); + FStar_Syntax_Syntax.mutuals1 = + (dd.FStar_Syntax_Syntax.mutuals1); + FStar_Syntax_Syntax.injective_type_params1 + = uu___8 + } in + FStar_Syntax_Syntax.Sig_datacon + uu___7 in + { + FStar_Syntax_Syntax.sigel = uu___6; + FStar_Syntax_Syntax.sigrng = + (se.FStar_Syntax_Syntax.sigrng); + FStar_Syntax_Syntax.sigquals = + (se.FStar_Syntax_Syntax.sigquals); + FStar_Syntax_Syntax.sigmeta = + (se.FStar_Syntax_Syntax.sigmeta); + FStar_Syntax_Syntax.sigattrs = + (se.FStar_Syntax_Syntax.sigattrs); + FStar_Syntax_Syntax.sigopens_and_abbrevs + = + (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); + FStar_Syntax_Syntax.sigopts = + (se.FStar_Syntax_Syntax.sigopts) + }) datas2 in let sig_bndle = let uu___5 = FStar_TypeChecker_Env.get_range env0 in @@ -2278,8 +2662,8 @@ let (check_inductive_well_typedness : (FStar_Syntax_Syntax.Sig_bundle { FStar_Syntax_Syntax.ses = - (FStar_Compiler_List.op_At tcs2 - datas2); + (FStar_Compiler_List.op_At tcs3 + datas3); FStar_Syntax_Syntax.lids = lids }); FStar_Syntax_Syntax.sigrng = uu___5; @@ -2292,7 +2676,7 @@ let (check_inductive_well_typedness : FStar_Syntax_Syntax.sigopts = FStar_Pervasives_Native.None } in - (sig_bndle, tcs2, datas2))))) + (sig_bndle, tcs3, datas3))))) let (early_prims_inductives : Prims.string Prims.list) = ["empty"; "trivial"; "equals"; "pair"; "sum"] let (mk_discriminator_and_indexed_projectors : @@ -3161,142 +3545,145 @@ let (mk_data_operations : FStar_Syntax_Syntax.us1 = uvs; FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = typ_lid; FStar_Syntax_Syntax.num_ty_params = n_typars; - FStar_Syntax_Syntax.mutuals1 = uu___;_} + FStar_Syntax_Syntax.mutuals1 = uu___; + FStar_Syntax_Syntax.injective_type_params1 = uu___1;_} -> - let uu___1 = FStar_Syntax_Subst.univ_var_opening uvs in - (match uu___1 with + let uu___2 = FStar_Syntax_Subst.univ_var_opening uvs in + (match uu___2 with | (univ_opening, uvs1) -> let t1 = FStar_Syntax_Subst.subst univ_opening t in - let uu___2 = FStar_Syntax_Util.arrow_formals t1 in - (match uu___2 with - | (formals, uu___3) -> - let uu___4 = + let uu___3 = FStar_Syntax_Util.arrow_formals t1 in + (match uu___3 with + | (formals, uu___4) -> + let uu___5 = let tps_opt = FStar_Compiler_Util.find_map tcs (fun se1 -> - let uu___5 = - let uu___6 = - let uu___7 = + let uu___6 = + let uu___7 = + let uu___8 = FStar_Syntax_Util.lid_of_sigelt se1 in - FStar_Compiler_Util.must uu___7 in - FStar_Ident.lid_equals typ_lid uu___6 in - if uu___5 + FStar_Compiler_Util.must uu___8 in + FStar_Ident.lid_equals typ_lid uu___7 in + if uu___6 then match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_inductive_typ - { FStar_Syntax_Syntax.lid = uu___6; + { FStar_Syntax_Syntax.lid = uu___7; FStar_Syntax_Syntax.us = uvs'; FStar_Syntax_Syntax.params = tps; FStar_Syntax_Syntax.num_uniform_params - = uu___7; + = uu___8; FStar_Syntax_Syntax.t = typ0; FStar_Syntax_Syntax.mutuals = - uu___8; - FStar_Syntax_Syntax.ds = constrs;_} + uu___9; + FStar_Syntax_Syntax.ds = constrs; + FStar_Syntax_Syntax.injective_type_params + = uu___10;_} -> FStar_Pervasives_Native.Some (tps, typ0, ((FStar_Compiler_List.length constrs) > Prims.int_one)) - | uu___6 -> + | uu___7 -> FStar_Compiler_Effect.failwith "Impossible" else FStar_Pervasives_Native.None) in match tps_opt with | FStar_Pervasives_Native.Some x -> x | FStar_Pervasives_Native.None -> - let uu___5 = + let uu___6 = FStar_Ident.lid_equals typ_lid FStar_Parser_Const.exn_lid in - if uu___5 + if uu___6 then ([], FStar_Syntax_Util.ktype0, true) else FStar_Errors.raise_error (FStar_Errors_Codes.Fatal_UnexpectedDataConstructor, "Unexpected data constructor") se.FStar_Syntax_Syntax.sigrng in - (match uu___4 with + (match uu___5 with | (inductive_tps, typ0, should_refine) -> let inductive_tps1 = FStar_Syntax_Subst.subst_binders univ_opening inductive_tps in let typ01 = - let uu___5 = + let uu___6 = FStar_Syntax_Subst.shift_subst (FStar_Compiler_List.length inductive_tps1) univ_opening in - FStar_Syntax_Subst.subst uu___5 typ0 in - let uu___5 = + FStar_Syntax_Subst.subst uu___6 typ0 in + let uu___6 = FStar_Syntax_Util.arrow_formals typ01 in - (match uu___5 with - | (indices, uu___6) -> + (match uu___6 with + | (indices, uu___7) -> let refine_domain = - let uu___7 = + let uu___8 = FStar_Compiler_Util.for_some - (fun uu___8 -> - match uu___8 with + (fun uu___9 -> + match uu___9 with | FStar_Syntax_Syntax.RecordConstructor - uu___9 -> true - | uu___9 -> false) + uu___10 -> true + | uu___10 -> false) se.FStar_Syntax_Syntax.sigquals in - if uu___7 then false else should_refine in + if uu___8 then false else should_refine in let fv_qual = - let filter_records uu___7 = - match uu___7 with + let filter_records uu___8 = + match uu___8 with | FStar_Syntax_Syntax.RecordConstructor - (uu___8, fns) -> + (uu___9, fns) -> FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor (typ_lid, fns)) - | uu___8 -> + | uu___9 -> FStar_Pervasives_Native.None in - let uu___7 = + let uu___8 = FStar_Compiler_Util.find_map se.FStar_Syntax_Syntax.sigquals filter_records in - match uu___7 with + match uu___8 with | FStar_Pervasives_Native.None -> FStar_Syntax_Syntax.Data_ctor | FStar_Pervasives_Native.Some q -> q in let fields = - let uu___7 = + let uu___8 = FStar_Compiler_Util.first_N n_typars formals in - match uu___7 with + match uu___8 with | (imp_tps, fields1) -> let rename = FStar_Compiler_List.map2 - (fun uu___8 -> - fun uu___9 -> - match (uu___8, uu___9) + (fun uu___9 -> + fun uu___10 -> + match (uu___9, uu___10) with | ({ FStar_Syntax_Syntax.binder_bv = x; FStar_Syntax_Syntax.binder_qual - = uu___10; - FStar_Syntax_Syntax.binder_positivity = uu___11; + FStar_Syntax_Syntax.binder_positivity + = uu___12; FStar_Syntax_Syntax.binder_attrs - = uu___12;_}, + = uu___13;_}, { FStar_Syntax_Syntax.binder_bv = x'; FStar_Syntax_Syntax.binder_qual - = uu___13; - FStar_Syntax_Syntax.binder_positivity = uu___14; + FStar_Syntax_Syntax.binder_positivity + = uu___15; FStar_Syntax_Syntax.binder_attrs - = uu___15;_}) + = uu___16;_}) -> - let uu___16 = - let uu___17 = + let uu___17 = + let uu___18 = FStar_Syntax_Syntax.bv_to_name x' in - (x, uu___17) in + (x, uu___18) in FStar_Syntax_Syntax.NT - uu___16) imp_tps + uu___17) imp_tps inductive_tps1 in FStar_Syntax_Subst.subst_binders rename fields1 in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml index 64154508e6c..b63e05a5320 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml @@ -122,12 +122,12 @@ let rec (eq_tm : let uu___3 = let uu___4 = let uu___5 = FStar_Syntax_Syntax.lid_of_fv f in - FStar_TypeChecker_Env.num_datacon_ty_params env - uu___5 in + FStar_TypeChecker_Env.num_datacon_non_injective_ty_params + env uu___5 in let uu___5 = let uu___6 = FStar_Syntax_Syntax.lid_of_fv g in - FStar_TypeChecker_Env.num_datacon_ty_params env - uu___6 in + FStar_TypeChecker_Env.num_datacon_non_injective_ty_params + env uu___6 in (uu___4, uu___5) in (match uu___3 with | (FStar_Pervasives_Native.Some n1, diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml index 58d65c13a78..b7ec7eb929b 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml @@ -8251,24 +8251,26 @@ let (try_lookup_record_type : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___5; FStar_Syntax_Syntax.num_ty_params = nparms; - FStar_Syntax_Syntax.mutuals1 = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_} + FStar_Syntax_Syntax.mutuals1 = uu___6; + FStar_Syntax_Syntax.injective_type_params1 = + uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_} -> - let uu___13 = FStar_Syntax_Util.arrow_formals t in - (match uu___13 with + let uu___14 = FStar_Syntax_Util.arrow_formals t in + (match uu___14 with | (formals, c) -> if nparms < (FStar_Compiler_List.length formals) then - let uu___14 = + let uu___15 = FStar_Compiler_List.splitAt nparms formals in - (match uu___14 with - | (uu___15, fields) -> + (match uu___15 with + | (uu___16, fields) -> let fields1 = FStar_Compiler_List.filter (fun b -> @@ -8276,8 +8278,8 @@ let (try_lookup_record_type : with | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit - uu___16) -> false - | uu___16 -> true) fields in + uu___17) -> false + | uu___17 -> true) fields in let fields2 = FStar_Compiler_List.map (fun b -> @@ -8288,13 +8290,13 @@ let (try_lookup_record_type : FStar_TypeChecker_Env.is_record env typename in let r = - let uu___16 = + let uu___17 = FStar_Ident.ident_of_lid dc in { FStar_Syntax_DsEnv.typename = typename; FStar_Syntax_DsEnv.constrname = - uu___16; + uu___17; FStar_Syntax_DsEnv.parms = []; FStar_Syntax_DsEnv.fields = fields2; FStar_Syntax_DsEnv.is_private = diff --git a/src/fstar/FStar.CheckedFiles.fst b/src/fstar/FStar.CheckedFiles.fst index f629b8e123d..b02e98a2d23 100644 --- a/src/fstar/FStar.CheckedFiles.fst +++ b/src/fstar/FStar.CheckedFiles.fst @@ -34,7 +34,7 @@ module Dep = FStar.Parser.Dep * detect when loading the cache that the version number is same * It needs to be kept in sync with prims.fst *) -let cache_version_number = 66 +let cache_version_number = 67 (* * Abbreviation for what we store in the checked files (stages as described below) diff --git a/src/reflection/FStar.Reflection.V1.Builtins.fst b/src/reflection/FStar.Reflection.V1.Builtins.fst index ce917c84858..4652661bf5b 100644 --- a/src/reflection/FStar.Reflection.V1.Builtins.fst +++ b/src/reflection/FStar.Reflection.V1.Builtins.fst @@ -639,12 +639,14 @@ let pack_sigelt (sv:sigelt_view) : sigelt = check_lid ind_lid; let s = SS.univ_var_closing us_names in let nparam = List.length param_bs in + //We can't tust the value of injective_type_params; set it to false here and let the typechecker recompute + let injective_type_params = false in let pack_ctor (c:ctor) : sigelt = let (nm, ty) = c in let lid = Ident.lid_of_path nm Range.dummyRange in let ty = U.arrow param_bs (S.mk_Total ty) in let ty = SS.subst s ty in (* close univs *) - mk_sigelt <| Sig_datacon {lid; us=us_names; t=ty; ty_lid=ind_lid; num_ty_params=nparam; mutuals=[]} + mk_sigelt <| Sig_datacon {lid; us=us_names; t=ty; ty_lid=ind_lid; num_ty_params=nparam; mutuals=[]; injective_type_params } in let ctor_ses : list sigelt = List.map pack_ctor ctors in @@ -665,7 +667,8 @@ let pack_sigelt (sv:sigelt_view) : sigelt = num_uniform_params=None; t=ty; mutuals=[]; - ds=c_lids} + ds=c_lids; + injective_type_params } in let se = mk_sigelt <| Sig_bundle {ses=ind_se::ctor_ses; lids=ind_lid::c_lids} in { se with sigquals = Noeq::se.sigquals } diff --git a/src/reflection/FStar.Reflection.V2.Builtins.fst b/src/reflection/FStar.Reflection.V2.Builtins.fst index 8cfa8dc0b72..484a5925f37 100644 --- a/src/reflection/FStar.Reflection.V2.Builtins.fst +++ b/src/reflection/FStar.Reflection.V2.Builtins.fst @@ -603,10 +603,12 @@ let pack_sigelt (sv:sigelt_view) : sigelt = let ind_lid = Ident.lid_of_path nm Range.dummyRange in check_lid ind_lid; let nparam = List.length param_bs in + //We can't tust the value of injective_type_params; set it to false here and let the typechecker recompute + let injective_type_params = false in let pack_ctor (c:ctor) : sigelt = let (nm, ty) = c in let lid = Ident.lid_of_path nm Range.dummyRange in - mk_sigelt <| Sig_datacon {lid; us=us_names; t=ty; ty_lid=ind_lid; num_ty_params=nparam; mutuals=[]} + mk_sigelt <| Sig_datacon {lid; us=us_names; t=ty; ty_lid=ind_lid; num_ty_params=nparam; mutuals=[]; injective_type_params } in let ctor_ses : list sigelt = List.map pack_ctor ctors in @@ -621,7 +623,8 @@ let pack_sigelt (sv:sigelt_view) : sigelt = num_uniform_params=None; t=ty; mutuals=[]; - ds=c_lids} + ds=c_lids; + injective_type_params } in let se = mk_sigelt <| Sig_bundle {ses=ind_se::ctor_ses; lids=ind_lid::c_lids} in { se with sigquals = Noeq::se.sigquals } diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index d0b6baf3355..a5d31e432a3 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -1005,95 +1005,11 @@ let encode_top_level_let : let decl = Caption ("let rec unencodeable: Skipping: " ^msg) in [decl] |> mk_decls_trivial, env - -let is_sig_inductive_injective_on_params (env:env_t) (se:sigelt) - : bool - = let Sig_inductive_typ { lid=t; us=universe_names; params=tps; t=k } = se.sigel in - let t_lid = t in - let tcenv = env.tcenv in - let usubst, uvs = SS.univ_var_opening universe_names in - let tcenv, tps, k = - Env.push_univ_vars tcenv uvs, - SS.subst_binders usubst tps, - SS.subst (SS.shift_subst (List.length tps) usubst) k - in - let tps, k = SS.open_term tps k in - let _, k = U.arrow_formals k in //don't care about indices here - let tps, env_tps, _, us = TcTerm.tc_binders tcenv tps in - let u_k = - TcTerm.level_of_type - env_tps - (S.mk_Tm_app - (S.fvar t None) - (snd (U.args_of_binders tps)) - (Ident.range_of_lid t)) - k - in - //BU.print2 "Universe of tycon: %s : %s\n" (Ident.string_of_lid t) (Print.univ_to_string u_k); - let rec universe_leq u v = - match u, v with - | U_zero, _ -> true - | U_succ u0, U_succ v0 -> universe_leq u0 v0 - | U_name u0, U_name v0 -> Ident.ident_equals u0 v0 - | U_name _, U_succ v0 -> universe_leq u v0 - | U_max us, _ -> us |> BU.for_all (fun u -> universe_leq u v) - | _, U_max vs -> vs |> BU.for_some (universe_leq u) - | U_unknown, _ - | _, U_unknown - | U_unif _, _ - | _, U_unif _ -> failwith (BU.format3 "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - (Ident.string_of_lid t) - (Print.univ_to_string u) - (Print.univ_to_string v)) - | _ -> false - in - let u_leq_u_k u = - let u = N.normalize_universe env_tps u in - universe_leq u u_k - in - let tp_ok (tp:S.binder) (u_tp:universe) = - let t_tp = tp.binder_bv.sort in - if u_leq_u_k u_tp - then true - else ( - let t_tp = - N.normalize - [Unrefine; Unascribe; Unmeta; - Primops; HNF; UnfoldUntil delta_constant; Beta] - env_tps t_tp - in - let formals, t = U.arrow_formals t_tp in - let _, _, _, u_formals = TcTerm.tc_binders env_tps formals in - let inj = BU.for_all (fun u_formal -> u_leq_u_k u_formal) u_formals in - if inj - then ( - match (SS.compress t).n with - | Tm_type u -> - (* retain injectivity for parameters that are type functions - from small universes (i.e., all formals are smaller than the constructed type) - to a universe <= the universe of the constructed type. - See BugBoxInjectivity.fst *) - u_leq_u_k u - | _ -> - false - ) - else ( - false - ) - - ) - in - let is_injective_on_params = List.forall2 tp_ok tps us in - if Env.debug env.tcenv <| Options.Other "SMTEncoding" - then BU.print2 "%s injectivity for %s\n" - (if is_injective_on_params then "YES" else "NO") - (Ident.string_of_lid t); - is_injective_on_params - - -let encode_sig_inductive (is_injective_on_params:bool) (env:env_t) (se:sigelt) +let encode_sig_inductive (env:env_t) (se:sigelt) : decls_t * env_t -= let Sig_inductive_typ { lid=t; us=universe_names; params=tps; t=k; ds=datas} = se.sigel in += let Sig_inductive_typ + { lid=t; us=universe_names; params=tps; + t=k; ds=datas; injective_type_params } = se.sigel in let t_lid = t in let tcenv = env.tcenv in let quals = se.sigquals in @@ -1113,7 +1029,7 @@ let encode_sig_inductive (is_injective_on_params:bool) (env:env_t) (se:sigelt) (fun (out, decls) l -> let is_l = mk_data_tester env l xx in let inversion_case, decls' = - if is_injective_on_params + if injective_type_params || Options.ext_getv "compat:injectivity" <> "" then ( let _, data_t = Env.lookup_datacon env.tcenv l in @@ -1216,13 +1132,13 @@ let encode_sig_inductive (is_injective_on_params:bool) (env:env_t) (se:sigelt) let aux = kindingAx @(inversion_axioms env tapp vars) - @([pretype_axiom (not is_injective_on_params) (Ident.range_of_lid t) env tapp vars] |> mk_decls_trivial) + @([pretype_axiom (not injective_type_params) (Ident.range_of_lid t) env tapp vars] |> mk_decls_trivial) in (decls |> mk_decls_trivial)@binder_decls@aux, env -let encode_datacon (is_injective_on_tparams:bool) (env:env_t) (se:sigelt) +let encode_datacon (env:env_t) (se:sigelt) : decls_t * env_t -= let Sig_datacon {lid=d; t; num_ty_params=n_tps; mutuals} = se.sigel in += let Sig_datacon {lid=d; t; num_ty_params=n_tps; mutuals; injective_type_params } = se.sigel in let quals = se.sigquals in let t = norm_before_encoding env t in let formals, t_res = U.arrow_formals t in @@ -1232,8 +1148,8 @@ let encode_datacon (is_injective_on_tparams:bool) (env:env_t) (se:sigelt) let fuel_var, fuel_tm = fresh_fvar env.current_module_name "f" Fuel_sort in let s_fuel_tm = mkApp("SFuel", [fuel_tm]) in let vars, guards, env', binder_decls, names = encode_binders (Some fuel_tm) formals env in - let is_injective_on_tparams = - is_injective_on_tparams || Options.ext_getv "compat:injectivity" <> "" + let injective_type_params = + injective_type_params || Options.ext_getv "compat:injectivity" <> "" in let fields = names |> @@ -1241,7 +1157,7 @@ let encode_datacon (is_injective_on_tparams:bool) (env:env_t) (se:sigelt) (fun n x -> let field_projectible = n >= n_tps || //either this field is not a type parameter - is_injective_on_tparams //or we are allowed to be injective on parameters + injective_type_params //or we are allowed to be injective on parameters in { field_name=mk_term_projector_name d x; field_sort=Term_sort; @@ -1252,7 +1168,7 @@ let encode_datacon (is_injective_on_tparams:bool) (env:env_t) (se:sigelt) constr_fields=fields; constr_sort=Term_sort; constr_id=Some (varops.next_id()); - constr_base=not is_injective_on_tparams + constr_base=not injective_type_params } |> Term.constructor_to_decl (Ident.range_of_lid d) in let app = mk_Apply ddtok_tm vars in let guard = mk_and_l guards in @@ -1761,15 +1677,6 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = encode_top_level_let env (is_rec, bindings) se.sigquals | Sig_bundle {ses} -> - let tycon = List.tryFind (fun se -> Sig_inductive_typ? se.sigel) ses in - let is_injective_on_params = - match tycon with - | None -> - //Exceptions appear as Sig_bundle without an inductive type - false - | Some se -> - is_sig_inductive_injective_on_params env se - in let g, env = ses |> List.fold_left @@ -1777,9 +1684,9 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = let g', env = match se.sigel with | Sig_inductive_typ _ -> - encode_sig_inductive is_injective_on_params env se + encode_sig_inductive env se | Sig_datacon _ -> - encode_datacon is_injective_on_params env se + encode_datacon env se | _ -> encode_sigelt env se in diff --git a/src/syntax/FStar.Syntax.MutRecTy.fst b/src/syntax/FStar.Syntax.MutRecTy.fst index ce8e61f5432..34e9c74ea70 100644 --- a/src/syntax/FStar.Syntax.MutRecTy.fst +++ b/src/syntax/FStar.Syntax.MutRecTy.fst @@ -193,7 +193,9 @@ let disentangle_abbrevs_from_bundle let unfold_in_sig (x: sigelt) = match x.sigel with | Sig_inductive_typ {lid; us=univs; params=bnd; - num_uniform_params=num_uniform; t=ty; mutuals=mut; ds=dc} -> + num_uniform_params=num_uniform; + t=ty; mutuals=mut; ds=dc; + injective_type_params } -> let bnd' = inst_binders unfold_fv bnd in let ty' = inst unfold_fv ty in let mut' = filter_out_type_abbrevs mut in @@ -203,9 +205,12 @@ let disentangle_abbrevs_from_bundle num_uniform_params=num_uniform; t=ty'; mutuals=mut'; - ds=dc} }] + ds=dc; + injective_type_params } }] - | Sig_datacon {lid; us=univs; t=ty; ty_lid=res; num_ty_params=npars; mutuals=mut} -> + | Sig_datacon {lid; us=univs; t=ty; ty_lid=res; + num_ty_params=npars; mutuals=mut; + injective_type_params } -> let ty' = inst unfold_fv ty in let mut' = filter_out_type_abbrevs mut in [{ x with sigel = Sig_datacon {lid; @@ -213,7 +218,8 @@ let disentangle_abbrevs_from_bundle t=ty'; ty_lid=res; num_ty_params=npars; - mutuals=mut'} }] + mutuals=mut'; + injective_type_params } }] | Sig_let _ -> [] diff --git a/src/syntax/FStar.Syntax.Syntax.fsti b/src/syntax/FStar.Syntax.Syntax.fsti index 0368a976caa..c9e8962fce2 100644 --- a/src/syntax/FStar.Syntax.Syntax.fsti +++ b/src/syntax/FStar.Syntax.Syntax.fsti @@ -656,6 +656,7 @@ type sigelt' = t:typ; //t mutuals:list lident; //mutually defined types ds:list lident; //data constructors for this type + injective_type_params:bool //is this type injective in its type parameters? } (* a datatype definition is a Sig_bundle of all mutually defined `Sig_inductive_typ`s and `Sig_datacon`s. perhaps it would be nicer to let this have a 2-level structure, e.g. list list sigelt, @@ -673,6 +674,7 @@ type sigelt' = ty_lid:lident; //the inductive type of the value this constructs num_ty_params:int; //and the number of parameters of the inductive mutuals:list lident; //mutually defined types + injective_type_params:bool //is this type injective in its type parameters? } | Sig_declare_typ { lid:lident; diff --git a/src/syntax/FStar.Syntax.VisitM.fst b/src/syntax/FStar.Syntax.VisitM.fst index 8af505aba0a..e55a731b2a9 100644 --- a/src/syntax/FStar.Syntax.VisitM.fst +++ b/src/syntax/FStar.Syntax.VisitM.fst @@ -377,18 +377,18 @@ let on_sub_action #m {|d : lvm m |} (a : action) : m action = let rec on_sub_sigelt' #m {|d : lvm m |} (se : sigelt') : m sigelt' = match se with - | Sig_inductive_typ {lid; us; params; num_uniform_params; t; mutuals; ds} -> + | Sig_inductive_typ {lid; us; params; num_uniform_params; t; mutuals; ds; injective_type_params } -> let! params = params |> mapM f_binder in let! t = t |> f_term in - return <| Sig_inductive_typ {lid; us; params; num_uniform_params; t; mutuals; ds} + return <| Sig_inductive_typ {lid; us; params; num_uniform_params; t; mutuals; ds; injective_type_params } | Sig_bundle {ses; lids} -> let! ses = ses |> mapM on_sub_sigelt in return <| Sig_bundle {ses; lids} - | Sig_datacon {lid; us; t; ty_lid; num_ty_params; mutuals} -> + | Sig_datacon {lid; us; t; ty_lid; num_ty_params; mutuals; injective_type_params } -> let! t = t |> f_term in - return <| Sig_datacon {lid; us; t; ty_lid; num_ty_params; mutuals} + return <| Sig_datacon {lid; us; t; ty_lid; num_ty_params; mutuals; injective_type_params } | Sig_declare_typ {lid; us; t} -> let! t = t |> f_term in diff --git a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst index a2809bf79d9..c0f10927ecd 100644 --- a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst +++ b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst @@ -627,14 +627,16 @@ let rec generalize_annotated_univs (s:sigelt) :sigelt = num_uniform_params=num_uniform; t=Subst.subst (Subst.shift_subst (List.length bs) usubst) t; mutuals=lids1; - ds=lids2} } + ds=lids2; + injective_type_params=false} } | Sig_datacon {lid;t;ty_lid=tlid;num_ty_params=n;mutuals=lids} -> { se with sigel = Sig_datacon {lid; us=unames; t=Subst.subst usubst t; ty_lid=tlid; num_ty_params=n; - mutuals=lids} } + mutuals=lids; + injective_type_params=false} } | _ -> failwith "Impossible: collect_annotated_universes: Sig_bundle should not have a non data/type sigelt" ); lids} } | Sig_declare_typ {lid; t} -> @@ -3007,7 +3009,8 @@ let rec desugar_tycon env (d: AST.decl) (d_attrs:list S.term) quals tcs : (env_t num_uniform_params=None; t=k; mutuals; - ds=[]}; + ds=[]; + injective_type_params=false}; sigquals = quals; sigrng = range_of_id id; sigmeta = default_sigmeta; @@ -3148,7 +3151,8 @@ let rec desugar_tycon env (d: AST.decl) (d_attrs:list S.term) quals tcs : (env_t params=tpars; num_uniform_params=num_uniform; t=k; - mutuals}; sigquals = tname_quals }, + mutuals; + injective_type_params}; sigquals = tname_quals }, constrs, tconstr, quals) -> let mk_tot t = let tot = mk_term (Name C.effect_Tot_lid) t.range t.level in @@ -3177,7 +3181,8 @@ let rec desugar_tycon env (d: AST.decl) (d_attrs:list S.term) quals tcs : (env_t t=U.arrow data_tpars (mk_Total (t |> U.name_function_binders)); ty_lid=tname; num_ty_params=ntps; - mutuals}; + mutuals; + injective_type_params}; sigquals = quals; sigrng = range_of_lid name; sigmeta = default_sigmeta ; @@ -3199,7 +3204,8 @@ let rec desugar_tycon env (d: AST.decl) (d_attrs:list S.term) quals tcs : (env_t num_uniform_params=num_uniform; t=k; mutuals; - ds=constrNames}; + ds=constrNames; + injective_type_params}; sigquals = tname_quals; sigrng = range_of_lid tname; sigmeta = default_sigmeta ; @@ -4084,7 +4090,7 @@ and desugar_decl_core env (d_attrs:list S.term) (d:decl) : (env_t * sigelts) = let l = qualify env id in let qual = [ExceptionConstructor] in let top_attrs = d_attrs in - let se = { sigel = Sig_datacon {lid=l;us=[];t;ty_lid=C.exn_lid;num_ty_params=0;mutuals=[C.exn_lid]}; + let se = { sigel = Sig_datacon {lid=l;us=[];t;ty_lid=C.exn_lid;num_ty_params=0;mutuals=[C.exn_lid];injective_type_params=false}; sigquals = qual; sigrng = d.drange; sigmeta = default_sigmeta ; diff --git a/src/typechecker/FStar.TypeChecker.Cfg.fst b/src/typechecker/FStar.TypeChecker.Cfg.fst index 39430271921..d7434cce192 100644 --- a/src/typechecker/FStar.TypeChecker.Cfg.fst +++ b/src/typechecker/FStar.TypeChecker.Cfg.fst @@ -374,7 +374,7 @@ let config' psteps s e = | [] -> [Env.NoDelta] | _ -> d in let steps = to_fsteps s |> add_nbe in - let psteps = add_steps (merge_steps (cached_steps ()) (env_dependent_ops e))psteps in + let psteps = add_steps (merge_steps (env_dependent_ops e) (cached_steps ())) psteps in let dbg_flag = List.contains NormDebug s in {tcenv = e; debug = if dbg_flag || Options.debug_any () then diff --git a/src/typechecker/FStar.TypeChecker.Env.fst b/src/typechecker/FStar.TypeChecker.Env.fst index 6ce5c890c6c..a8517d75a5b 100644 --- a/src/typechecker/FStar.TypeChecker.Env.fst +++ b/src/typechecker/FStar.TypeChecker.Env.fst @@ -745,9 +745,10 @@ let typ_of_datacon env lid = | Some (Inr ({ sigel = Sig_datacon {ty_lid=l} }, _), _) -> l | _ -> failwith (BU.format1 "Not a datacon: %s" (Print.lid_to_string lid)) -let num_datacon_ty_params env lid = +let num_datacon_non_injective_ty_params env lid = match lookup_qname env lid with - | Some (Inr ({ sigel = Sig_datacon {num_ty_params} }, _), _) -> Some num_ty_params + | Some (Inr ({ sigel = Sig_datacon {num_ty_params; injective_type_params} }, _), _) -> + if injective_type_params then Some 0 else Some num_ty_params | _ -> None let lookup_definition_qninfo_aux rec_ok delta_levels lid (qninfo : qninfo) = diff --git a/src/typechecker/FStar.TypeChecker.Env.fsti b/src/typechecker/FStar.TypeChecker.Env.fsti index f3d76452836..fbf71f6c396 100644 --- a/src/typechecker/FStar.TypeChecker.Env.fsti +++ b/src/typechecker/FStar.TypeChecker.Env.fsti @@ -344,7 +344,7 @@ val is_irreducible : env -> lident -> bool val is_type_constructor : env -> lident -> bool val num_inductive_ty_params: env -> lident -> option int val num_inductive_uniform_ty_params: env -> lident -> option int -val num_datacon_ty_params : env -> lident -> option int +val num_datacon_non_injective_ty_params : env -> lident -> option int val delta_depth_of_qninfo : fv -> qninfo -> option delta_depth val delta_depth_of_fv : env -> fv -> delta_depth diff --git a/src/typechecker/FStar.TypeChecker.NBETerm.fst b/src/typechecker/FStar.TypeChecker.NBETerm.fst index 37fbb5a94a0..8a0d40ea096 100644 --- a/src/typechecker/FStar.TypeChecker.NBETerm.fst +++ b/src/typechecker/FStar.TypeChecker.NBETerm.fst @@ -123,7 +123,7 @@ let rec eq_t env (t1 : t) (t2 : t) : TEQ.eq_result = if S.fv_eq v1 v2 then begin if List.length args1 <> List.length args2 then failwith "eq_t, different number of args on Construct"; - match Env.num_datacon_ty_params env (lid_of_fv v1) with + match Env.num_datacon_non_injective_ty_params env (lid_of_fv v1) with | None -> TEQ.Unknown | Some n -> if n <= List.length args1 diff --git a/src/typechecker/FStar.TypeChecker.Normalize.fst b/src/typechecker/FStar.TypeChecker.Normalize.fst index 44d3c5d5070..6e5385f78e8 100644 --- a/src/typechecker/FStar.TypeChecker.Normalize.fst +++ b/src/typechecker/FStar.TypeChecker.Normalize.fst @@ -3290,7 +3290,8 @@ let rec elim_uvars (env:Env.env) (s:sigelt) = num_uniform_params=num_uniform; t=typ; mutuals=lids; - ds=lids'} -> + ds=lids'; + injective_type_params} -> let univ_names, binders, typ = elim_uvars_aux_t env univ_names binders typ in {s with sigel = Sig_inductive_typ {lid; us=univ_names; @@ -3298,19 +3299,21 @@ let rec elim_uvars (env:Env.env) (s:sigelt) = num_uniform_params=num_uniform; t=typ; mutuals=lids; - ds=lids'}} + ds=lids'; + injective_type_params}} | Sig_bundle {ses=sigs; lids} -> {s with sigel = Sig_bundle {ses=List.map (elim_uvars env) sigs; lids}} - | Sig_datacon {lid; us=univ_names; t=typ; ty_lid=lident; num_ty_params=i; mutuals=lids} -> + | Sig_datacon {lid; us=univ_names; t=typ; ty_lid=lident; num_ty_params=i; mutuals=lids; injective_type_params} -> let univ_names, _, typ = elim_uvars_aux_t env univ_names [] typ in {s with sigel = Sig_datacon {lid; us=univ_names; t=typ; ty_lid=lident; num_ty_params=i; - mutuals=lids}} + mutuals=lids; + injective_type_params}} | Sig_declare_typ {lid; us=univ_names; t=typ} -> let univ_names, _, typ = elim_uvars_aux_t env univ_names [] typ in diff --git a/src/typechecker/FStar.TypeChecker.Positivity.fst b/src/typechecker/FStar.TypeChecker.Positivity.fst index 5db4276ffee..9bc9817e720 100644 --- a/src/typechecker/FStar.TypeChecker.Positivity.fst +++ b/src/typechecker/FStar.TypeChecker.Positivity.fst @@ -366,7 +366,7 @@ let mark_uniform_type_parameters (env:env_t) (sig:sigelt) : sigelt = let mark_tycon_parameters tc datas = - let Sig_inductive_typ {lid=tc_lid; us; params=ty_param_binders; t; mutuals; ds=data_lids} = tc.sigel in + let Sig_inductive_typ {lid=tc_lid; us; params=ty_param_binders; t; mutuals; ds=data_lids; injective_type_params } = tc.sigel in let env, (tc_lid, us, ty_params) = open_sig_inductive_typ env tc in let _, ty_param_args = U.args_of_binders ty_params in let datacon_fields : list (list binder) = @@ -418,7 +418,8 @@ let mark_uniform_type_parameters (env:env_t) num_uniform_params=Some max_uniform_prefix; t; mutuals; - ds=data_lids} in + ds=data_lids; + injective_type_params} in { tc with sigel } in match sig.sigel with diff --git a/src/typechecker/FStar.TypeChecker.TcInductive.fst b/src/typechecker/FStar.TypeChecker.TcInductive.fst index f4c6c9baffe..7c5aa867cd0 100644 --- a/src/typechecker/FStar.TypeChecker.TcInductive.fst +++ b/src/typechecker/FStar.TypeChecker.TcInductive.fst @@ -46,6 +46,90 @@ module C = FStar.Parser.Const let unfold_whnf = N.unfold_whnf' [Env.AllowUnboundUniverses] +let check_sig_inductive_injectivity_on_params (tcenv:env_t) (se:sigelt) + : sigelt + = let Sig_inductive_typ dd = se.sigel in + let { lid=t; us=universe_names; params=tps; t=k } = dd in + let t_lid = t in + let usubst, uvs = SS.univ_var_opening universe_names in + let tcenv, tps, k = + Env.push_univ_vars tcenv uvs, + SS.subst_binders usubst tps, + SS.subst (SS.shift_subst (List.length tps) usubst) k + in + let tps, k = SS.open_term tps k in + let _, k = U.arrow_formals k in //don't care about indices here + let tps, env_tps, _, us = TcTerm.tc_binders tcenv tps in + let u_k = + TcTerm.level_of_type + env_tps + (S.mk_Tm_app + (S.fvar t None) + (snd (U.args_of_binders tps)) + (Ident.range_of_lid t)) + k + in + //BU.print2 "Universe of tycon: %s : %s\n" (Ident.string_of_lid t) (Print.univ_to_string u_k); + let rec universe_leq u v = + match u, v with + | U_zero, _ -> true + | U_succ u0, U_succ v0 -> universe_leq u0 v0 + | U_name u0, U_name v0 -> Ident.ident_equals u0 v0 + | U_name _, U_succ v0 -> universe_leq u v0 + | U_max us, _ -> us |> BU.for_all (fun u -> universe_leq u v) + | _, U_max vs -> vs |> BU.for_some (universe_leq u) + | U_unknown, _ + | _, U_unknown + | U_unif _, _ + | _, U_unif _ -> failwith (BU.format3 "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + (Ident.string_of_lid t) + (Print.univ_to_string u) + (Print.univ_to_string v)) + | _ -> false + in + let u_leq_u_k u = + let u = N.normalize_universe env_tps u in + universe_leq u u_k + in + let tp_ok (tp:S.binder) (u_tp:universe) = + let t_tp = tp.binder_bv.sort in + if u_leq_u_k u_tp + then true + else ( + let t_tp = + N.normalize + [Unrefine; Unascribe; Unmeta; + Primops; HNF; UnfoldUntil delta_constant; Beta] + env_tps t_tp + in + let formals, t = U.arrow_formals t_tp in + let _, _, _, u_formals = TcTerm.tc_binders env_tps formals in + let inj = BU.for_all (fun u_formal -> u_leq_u_k u_formal) u_formals in + if inj + then ( + match (SS.compress t).n with + | Tm_type u -> + (* retain injectivity for parameters that are type functions + from small universes (i.e., all formals are smaller than the constructed type) + to a universe <= the universe of the constructed type. + See BugBoxInjectivity.fst *) + u_leq_u_k u + | _ -> + false + ) + else ( + false + ) + + ) + in + let injective_type_params = List.forall2 tp_ok tps us in + if Env.debug tcenv <| Options.Other "TcInductive" + then BU.print2 "%s injectivity for %s\n" + (if injective_type_params then "YES" else "NO") + (Ident.string_of_lid t); + { se with sigel = Sig_inductive_typ { dd with injective_type_params } } + let tc_tycon (env:env_t) (* environment that contains all mutually defined type constructors *) (s:sigelt) (* a Sig_inductive_type (aka tc) that needs to be type-checked *) : env_t (* environment extended with a refined type for the type-constructor *) @@ -104,7 +188,8 @@ let tc_tycon (env:env_t) (* environment that contains all mutually defined t num_uniform_params=n_uniform; t=k; mutuals; - ds=data} }, + ds=data; + injective_type_params=false} }, u, guard @@ -235,7 +320,8 @@ let tc_data (env:env_t) (tcs : list (sigelt * universe)) t; ty_lid=tc_lid; num_ty_params=ntps; - mutuals=mutual_tcs} }, + mutuals=mutual_tcs; + injective_type_params=false} }, g | _ -> failwith "impossible" @@ -290,7 +376,8 @@ let generalize_and_inst_within (env:env_t) (tcs:list (sigelt * universe)) (datas num_uniform_params=num_uniform; t; mutuals; - ds=datas} } + ds=datas; + injective_type_params=false} } | _ -> failwith "Impossible") tc_types tcs in @@ -310,7 +397,8 @@ let generalize_and_inst_within (env:env_t) (tcs:list (sigelt * universe)) (datas t=ty; ty_lid=tc; num_ty_params=ntps; - mutuals} } + mutuals; + injective_type_params=false} } | _ -> failwith "Impossible") data_types datas in @@ -857,13 +945,33 @@ let check_inductive_well_typedness (env:env_t) (ses:list sigelt) (quals:list qua num_uniform_params=num_uniform; t=typ; mutuals=ts; - ds}} + ds; + injective_type_params=false}} end else fail expected_typ inferred_typ else fail expected_typ (inferred_typ_with_binders binders) end | _ -> se) in + let tcs = tcs |> List.map (check_sig_inductive_injectivity_on_params env) in + let is_injective l = + match + List.tryPick + (fun se -> + let Sig_inductive_typ {lid=lid; injective_type_params} = se.sigel in + if lid_equals l lid then Some injective_type_params else None) + tcs + with + | None -> false + | Some i -> i + in + let datas = + datas |> + List.map + (fun se -> + let Sig_datacon dd = se.sigel in + { se with sigel=Sig_datacon { dd with injective_type_params=is_injective dd.ty_lid }}) + in let sig_bndle = { sigel = Sig_bundle {ses=tcs@datas; lids}; sigquals = quals; sigrng = Env.get_range env0; diff --git a/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst b/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst index 4b2af53498d..e7d5ae2cc4f 100644 --- a/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst +++ b/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst @@ -125,7 +125,8 @@ let rec eq_tm (env:env_t) (t1:term) (t2:term) : eq_result = | Tm_fvar f, Tm_fvar g when qual_is_inj f.fv_qual && qual_is_inj g.fv_qual -> ( - match Env.num_datacon_ty_params env (lid_of_fv f), Env.num_datacon_ty_params env (lid_of_fv g) with + match Env.num_datacon_non_injective_ty_params env (lid_of_fv f), + Env.num_datacon_non_injective_ty_params env (lid_of_fv g) with | Some n1, Some n2 -> if n1 <= List.length args1 && n2 <= List.length args2 diff --git a/tests/bug-reports/BugBoxInjectivity.fst b/tests/bug-reports/BugBoxInjectivity.fst index 506ab6f0633..11639740730 100644 --- a/tests/bug-reports/BugBoxInjectivity.fst +++ b/tests/bug-reports/BugBoxInjectivity.fst @@ -78,3 +78,52 @@ let bad (h0:ceq true true) (h1:ceq false false) : Lemma (true == false) = let Refl = h0 in let Refl = h1 in () + +//Another test case, to make sure that the normalizer doesn't enforce injectivity of +//type parameter arguments of a data constructor + +module T = FStar.Tactics +type idx : Type u#2 = | A1 | A2 + +noeq +type test3 (a:idx) : Type u#1 = + | Mk3 : test3 a + +let case0 (x0 : test3 A1) (x1 : test3 A2) : Lemma False = + assume (test3 A1 == test3 A2); + assume (~ (Mk3 #A1 == coerce_eq () (Mk3 #A2))) + +[@@expect_failure] +let case1 (x0 : test3 A1) (x1 : test3 A2) : Lemma False = + assume (test3 A1 == test3 A2); + assert (~ (Mk3 #A1 == coerce_eq () (Mk3 #A2))) + by (T.norm [delta;primops]; + T.trefl ()) + +[@@expect_failure] +let case2 (x0 : test3 A1) (x1 : test3 A2) : Lemma False = + assume (test3 A1 == test3 A2); + assert (~ (Mk3 #A1 == coerce_eq () (Mk3 #A2))) + by (T.norm [delta;primops;nbe]; + T.trefl ()) + + +[@@expect_failure] +let case4 (x0 : test3 A1) (x1 : test3 A2) : Lemma (test3 A1 == test3 A2 ==> Mk3 #A1 == coerce_eq () (Mk3 #A2)) = + assume (test3 A1 == test3 A2); + assert (Mk3 #A1 == coerce_eq () (Mk3 #A2)) + by (T.norm [delta;primops]; + T.trivial()) //this can't be proven by the normalizer alone + +[@@expect_failure] +let case5 (x0 : test3 A1) (x1 : test3 A2) : Lemma (test3 A1 == test3 A2 ==> Mk3 #A1 == coerce_eq () (Mk3 #A2)) = + assume (test3 A1 == test3 A2); + assert (Mk3 #A1 == coerce_eq () (Mk3 #A2)) + by (T.norm [delta;primops;nbe]; + T.trivial()) //this can't be proven by the normalizer alone; nor by nbe + +let case6 (x0 : test3 A1) (x1 : test3 A2) : Lemma (test3 A1 == test3 A2 ==> Mk3 #A1 == coerce_eq () (Mk3 #A2)) = + assume (test3 A1 == test3 A2); + assert (Mk3 #A1 == coerce_eq () (Mk3 #A2)) + by (T.norm [delta;primops]; + T.smt()) //but it can by SMT, since the parameters are irrelevant diff --git a/ulib/prims.fst b/ulib/prims.fst index 395ff6206c5..18130765343 100644 --- a/ulib/prims.fst +++ b/ulib/prims.fst @@ -708,4 +708,4 @@ val string_of_int: int -> Tot string (** THIS IS MEANT TO BE KEPT IN SYNC WITH FStar.CheckedFiles.fs Incrementing this forces all .checked files to be invalidated *) irreducible -let __cache_version_number__ = 66 +let __cache_version_number__ = 67 From 42bba1e4e2d0037ec53d7d48543eda4740465502 Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Fri, 26 Apr 2024 18:05:48 -0700 Subject: [PATCH 120/239] compute injective_type_params flag in phase2 only --- .../FStar_TypeChecker_TcInductive.ml | 534 +++++++++--------- .../FStar.TypeChecker.TcInductive.fst | 5 +- 2 files changed, 279 insertions(+), 260 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml index ce84b3f0f05..7a9d938610d 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml @@ -11,264 +11,282 @@ let (check_sig_inductive_injectivity_on_params : = fun tcenv -> fun se -> - let uu___ = se.FStar_Syntax_Syntax.sigel in - match uu___ with - | FStar_Syntax_Syntax.Sig_inductive_typ dd -> - let uu___1 = dd in - (match uu___1 with - | { FStar_Syntax_Syntax.lid = t; - FStar_Syntax_Syntax.us = universe_names; - FStar_Syntax_Syntax.params = tps; - FStar_Syntax_Syntax.num_uniform_params = uu___2; - FStar_Syntax_Syntax.t = k; - FStar_Syntax_Syntax.mutuals = uu___3; - FStar_Syntax_Syntax.ds = uu___4; - FStar_Syntax_Syntax.injective_type_params = uu___5;_} -> - let t_lid = t in - let uu___6 = - FStar_Syntax_Subst.univ_var_opening universe_names in - (match uu___6 with - | (usubst, uvs) -> - let uu___7 = - let uu___8 = - FStar_TypeChecker_Env.push_univ_vars tcenv uvs in - let uu___9 = - FStar_Syntax_Subst.subst_binders usubst tps in - let uu___10 = - let uu___11 = - FStar_Syntax_Subst.shift_subst - (FStar_Compiler_List.length tps) usubst in - FStar_Syntax_Subst.subst uu___11 k in - (uu___8, uu___9, uu___10) in - (match uu___7 with - | (tcenv1, tps1, k1) -> - let uu___8 = FStar_Syntax_Subst.open_term tps1 k1 in - (match uu___8 with - | (tps2, k2) -> - let uu___9 = FStar_Syntax_Util.arrow_formals k2 in - (match uu___9 with - | (uu___10, k3) -> - let uu___11 = - FStar_TypeChecker_TcTerm.tc_binders - tcenv1 tps2 in - (match uu___11 with - | (tps3, env_tps, uu___12, us) -> - let u_k = - let uu___13 = - let uu___14 = - FStar_Syntax_Syntax.fvar t - FStar_Pervasives_Native.None in - let uu___15 = - let uu___16 = - FStar_Syntax_Util.args_of_binders - tps3 in - FStar_Pervasives_Native.snd - uu___16 in - let uu___16 = - FStar_Ident.range_of_lid t in - FStar_Syntax_Syntax.mk_Tm_app - uu___14 uu___15 uu___16 in - FStar_TypeChecker_TcTerm.level_of_type - env_tps uu___13 k3 in - let rec universe_leq u v = - match (u, v) with - | (FStar_Syntax_Syntax.U_zero, - uu___13) -> true - | (FStar_Syntax_Syntax.U_succ u0, - FStar_Syntax_Syntax.U_succ v0) - -> universe_leq u0 v0 - | (FStar_Syntax_Syntax.U_name u0, - FStar_Syntax_Syntax.U_name v0) - -> - FStar_Ident.ident_equals u0 v0 - | (FStar_Syntax_Syntax.U_name - uu___13, - FStar_Syntax_Syntax.U_succ v0) - -> universe_leq u v0 - | (FStar_Syntax_Syntax.U_max us1, - uu___13) -> - FStar_Compiler_Util.for_all - (fun u1 -> universe_leq u1 v) - us1 - | (uu___13, - FStar_Syntax_Syntax.U_max vs) -> - FStar_Compiler_Util.for_some - (universe_leq u) vs - | (FStar_Syntax_Syntax.U_unknown, - uu___13) -> - let uu___14 = - let uu___15 = - FStar_Ident.string_of_lid t in - let uu___16 = - FStar_Syntax_Print.univ_to_string - u in - let uu___17 = - FStar_Syntax_Print.univ_to_string - v in - FStar_Compiler_Util.format3 - "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - uu___15 uu___16 uu___17 in - FStar_Compiler_Effect.failwith - uu___14 - | (uu___13, - FStar_Syntax_Syntax.U_unknown) - -> - let uu___14 = - let uu___15 = - FStar_Ident.string_of_lid t in - let uu___16 = - FStar_Syntax_Print.univ_to_string - u in - let uu___17 = - FStar_Syntax_Print.univ_to_string - v in - FStar_Compiler_Util.format3 - "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - uu___15 uu___16 uu___17 in - FStar_Compiler_Effect.failwith - uu___14 - | (FStar_Syntax_Syntax.U_unif - uu___13, uu___14) -> - let uu___15 = - let uu___16 = - FStar_Ident.string_of_lid t in - let uu___17 = - FStar_Syntax_Print.univ_to_string - u in - let uu___18 = - FStar_Syntax_Print.univ_to_string - v in - FStar_Compiler_Util.format3 - "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - uu___16 uu___17 uu___18 in - FStar_Compiler_Effect.failwith - uu___15 - | (uu___13, - FStar_Syntax_Syntax.U_unif - uu___14) -> - let uu___15 = - let uu___16 = - FStar_Ident.string_of_lid t in - let uu___17 = - FStar_Syntax_Print.univ_to_string - u in - let uu___18 = - FStar_Syntax_Print.univ_to_string - v in - FStar_Compiler_Util.format3 - "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - uu___16 uu___17 uu___18 in - FStar_Compiler_Effect.failwith - uu___15 - | uu___13 -> false in - let u_leq_u_k u = - let u1 = - FStar_TypeChecker_Normalize.normalize_universe - env_tps u in - universe_leq u1 u_k in - let tp_ok tp u_tp = - let t_tp = - (tp.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in - let uu___13 = u_leq_u_k u_tp in - if uu___13 - then true - else - (let t_tp1 = - FStar_TypeChecker_Normalize.normalize - [FStar_TypeChecker_Env.Unrefine; - FStar_TypeChecker_Env.Unascribe; - FStar_TypeChecker_Env.Unmeta; - FStar_TypeChecker_Env.Primops; - FStar_TypeChecker_Env.HNF; - FStar_TypeChecker_Env.UnfoldUntil - FStar_Syntax_Syntax.delta_constant; - FStar_TypeChecker_Env.Beta] - env_tps t_tp in - let uu___15 = - FStar_Syntax_Util.arrow_formals - t_tp1 in - match uu___15 with - | (formals, t1) -> + if tcenv.FStar_TypeChecker_Env.phase1 + then se + else + (let uu___1 = se.FStar_Syntax_Syntax.sigel in + match uu___1 with + | FStar_Syntax_Syntax.Sig_inductive_typ dd -> + let uu___2 = dd in + (match uu___2 with + | { FStar_Syntax_Syntax.lid = t; + FStar_Syntax_Syntax.us = universe_names; + FStar_Syntax_Syntax.params = tps; + FStar_Syntax_Syntax.num_uniform_params = uu___3; + FStar_Syntax_Syntax.t = k; + FStar_Syntax_Syntax.mutuals = uu___4; + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> + let t_lid = t in + let uu___7 = + FStar_Syntax_Subst.univ_var_opening universe_names in + (match uu___7 with + | (usubst, uvs) -> + let uu___8 = + let uu___9 = + FStar_TypeChecker_Env.push_univ_vars tcenv uvs in + let uu___10 = + FStar_Syntax_Subst.subst_binders usubst tps in + let uu___11 = + let uu___12 = + FStar_Syntax_Subst.shift_subst + (FStar_Compiler_List.length tps) usubst in + FStar_Syntax_Subst.subst uu___12 k in + (uu___9, uu___10, uu___11) in + (match uu___8 with + | (tcenv1, tps1, k1) -> + let uu___9 = FStar_Syntax_Subst.open_term tps1 k1 in + (match uu___9 with + | (tps2, k2) -> + let uu___10 = + FStar_Syntax_Util.arrow_formals k2 in + (match uu___10 with + | (uu___11, k3) -> + let uu___12 = + FStar_TypeChecker_TcTerm.tc_binders + tcenv1 tps2 in + (match uu___12 with + | (tps3, env_tps, uu___13, us) -> + let u_k = + let uu___14 = + let uu___15 = + FStar_Syntax_Syntax.fvar t + FStar_Pervasives_Native.None in + let uu___16 = + let uu___17 = + FStar_Syntax_Util.args_of_binders + tps3 in + FStar_Pervasives_Native.snd + uu___17 in + let uu___17 = + FStar_Ident.range_of_lid t in + FStar_Syntax_Syntax.mk_Tm_app + uu___15 uu___16 uu___17 in + FStar_TypeChecker_TcTerm.level_of_type + env_tps uu___14 k3 in + let rec universe_leq u v = + match (u, v) with + | (FStar_Syntax_Syntax.U_zero, + uu___14) -> true + | (FStar_Syntax_Syntax.U_succ + u0, + FStar_Syntax_Syntax.U_succ + v0) -> universe_leq u0 v0 + | (FStar_Syntax_Syntax.U_name + u0, + FStar_Syntax_Syntax.U_name + v0) -> + FStar_Ident.ident_equals u0 + v0 + | (FStar_Syntax_Syntax.U_name + uu___14, + FStar_Syntax_Syntax.U_succ + v0) -> universe_leq u v0 + | (FStar_Syntax_Syntax.U_max + us1, uu___14) -> + FStar_Compiler_Util.for_all + (fun u1 -> + universe_leq u1 v) us1 + | (uu___14, + FStar_Syntax_Syntax.U_max vs) + -> + FStar_Compiler_Util.for_some + (universe_leq u) vs + | (FStar_Syntax_Syntax.U_unknown, + uu___14) -> + let uu___15 = + let uu___16 = + FStar_Ident.string_of_lid + t in + let uu___17 = + FStar_Syntax_Print.univ_to_string + u in + let uu___18 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___16 uu___17 uu___18 in + FStar_Compiler_Effect.failwith + uu___15 + | (uu___14, + FStar_Syntax_Syntax.U_unknown) + -> + let uu___15 = + let uu___16 = + FStar_Ident.string_of_lid + t in + let uu___17 = + FStar_Syntax_Print.univ_to_string + u in + let uu___18 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___16 uu___17 uu___18 in + FStar_Compiler_Effect.failwith + uu___15 + | (FStar_Syntax_Syntax.U_unif + uu___14, uu___15) -> let uu___16 = - FStar_TypeChecker_TcTerm.tc_binders - env_tps formals in - (match uu___16 with - | (uu___17, uu___18, - uu___19, u_formals) -> - let inj = - FStar_Compiler_Util.for_all - (fun u_formal -> - u_leq_u_k - u_formal) - u_formals in - if inj - then - let uu___20 = - let uu___21 = - FStar_Syntax_Subst.compress - t1 in - uu___21.FStar_Syntax_Syntax.n in - (match uu___20 with - | FStar_Syntax_Syntax.Tm_type - u -> u_leq_u_k u - | uu___21 -> false) - else false)) in - let injective_type_params = - FStar_Compiler_List.forall2 tp_ok - tps3 us in - ((let uu___14 = - FStar_TypeChecker_Env.debug - tcenv1 - (FStar_Options.Other - "TcInductive") in - if uu___14 - then - let uu___15 = - FStar_Ident.string_of_lid t in - FStar_Compiler_Util.print2 - "%s injectivity for %s\n" - (if injective_type_params - then "YES" - else "NO") uu___15 - else ()); - { - FStar_Syntax_Syntax.sigel = - (FStar_Syntax_Syntax.Sig_inductive_typ - { - FStar_Syntax_Syntax.lid = - (dd.FStar_Syntax_Syntax.lid); - FStar_Syntax_Syntax.us = - (dd.FStar_Syntax_Syntax.us); - FStar_Syntax_Syntax.params - = - (dd.FStar_Syntax_Syntax.params); - FStar_Syntax_Syntax.num_uniform_params - = - (dd.FStar_Syntax_Syntax.num_uniform_params); - FStar_Syntax_Syntax.t = - (dd.FStar_Syntax_Syntax.t); - FStar_Syntax_Syntax.mutuals - = - (dd.FStar_Syntax_Syntax.mutuals); - FStar_Syntax_Syntax.ds = - (dd.FStar_Syntax_Syntax.ds); - FStar_Syntax_Syntax.injective_type_params - = injective_type_params - }); - FStar_Syntax_Syntax.sigrng = - (se.FStar_Syntax_Syntax.sigrng); - FStar_Syntax_Syntax.sigquals = - (se.FStar_Syntax_Syntax.sigquals); - FStar_Syntax_Syntax.sigmeta = - (se.FStar_Syntax_Syntax.sigmeta); - FStar_Syntax_Syntax.sigattrs = - (se.FStar_Syntax_Syntax.sigattrs); - FStar_Syntax_Syntax.sigopens_and_abbrevs - = - (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); - FStar_Syntax_Syntax.sigopts = - (se.FStar_Syntax_Syntax.sigopts) - }))))))) + let uu___17 = + FStar_Ident.string_of_lid + t in + let uu___18 = + FStar_Syntax_Print.univ_to_string + u in + let uu___19 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___17 uu___18 uu___19 in + FStar_Compiler_Effect.failwith + uu___16 + | (uu___14, + FStar_Syntax_Syntax.U_unif + uu___15) -> + let uu___16 = + let uu___17 = + FStar_Ident.string_of_lid + t in + let uu___18 = + FStar_Syntax_Print.univ_to_string + u in + let uu___19 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___17 uu___18 uu___19 in + FStar_Compiler_Effect.failwith + uu___16 + | uu___14 -> false in + let u_leq_u_k u = + let u1 = + FStar_TypeChecker_Normalize.normalize_universe + env_tps u in + universe_leq u1 u_k in + let tp_ok tp u_tp = + let t_tp = + (tp.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in + let uu___14 = u_leq_u_k u_tp in + if uu___14 + then true + else + (let t_tp1 = + FStar_TypeChecker_Normalize.normalize + [FStar_TypeChecker_Env.Unrefine; + FStar_TypeChecker_Env.Unascribe; + FStar_TypeChecker_Env.Unmeta; + FStar_TypeChecker_Env.Primops; + FStar_TypeChecker_Env.HNF; + FStar_TypeChecker_Env.UnfoldUntil + FStar_Syntax_Syntax.delta_constant; + FStar_TypeChecker_Env.Beta] + env_tps t_tp in + let uu___16 = + FStar_Syntax_Util.arrow_formals + t_tp1 in + match uu___16 with + | (formals, t1) -> + let uu___17 = + FStar_TypeChecker_TcTerm.tc_binders + env_tps formals in + (match uu___17 with + | (uu___18, uu___19, + uu___20, u_formals) + -> + let inj = + FStar_Compiler_Util.for_all + (fun u_formal -> + u_leq_u_k + u_formal) + u_formals in + if inj + then + let uu___21 = + let uu___22 = + FStar_Syntax_Subst.compress + t1 in + uu___22.FStar_Syntax_Syntax.n in + (match uu___21 + with + | FStar_Syntax_Syntax.Tm_type + u -> + u_leq_u_k u + | uu___22 -> + false) + else false)) in + let injective_type_params = + FStar_Compiler_List.forall2 + tp_ok tps3 us in + ((let uu___15 = + FStar_TypeChecker_Env.debug + tcenv1 + (FStar_Options.Other + "TcInductive") in + if uu___15 + then + let uu___16 = + FStar_Ident.string_of_lid t in + FStar_Compiler_Util.print2 + "%s injectivity for %s\n" + (if injective_type_params + then "YES" + else "NO") uu___16 + else ()); + { + FStar_Syntax_Syntax.sigel = + (FStar_Syntax_Syntax.Sig_inductive_typ + { + FStar_Syntax_Syntax.lid + = + (dd.FStar_Syntax_Syntax.lid); + FStar_Syntax_Syntax.us = + (dd.FStar_Syntax_Syntax.us); + FStar_Syntax_Syntax.params + = + (dd.FStar_Syntax_Syntax.params); + FStar_Syntax_Syntax.num_uniform_params + = + (dd.FStar_Syntax_Syntax.num_uniform_params); + FStar_Syntax_Syntax.t = + (dd.FStar_Syntax_Syntax.t); + FStar_Syntax_Syntax.mutuals + = + (dd.FStar_Syntax_Syntax.mutuals); + FStar_Syntax_Syntax.ds = + (dd.FStar_Syntax_Syntax.ds); + FStar_Syntax_Syntax.injective_type_params + = + injective_type_params + }); + FStar_Syntax_Syntax.sigrng = + (se.FStar_Syntax_Syntax.sigrng); + FStar_Syntax_Syntax.sigquals = + (se.FStar_Syntax_Syntax.sigquals); + FStar_Syntax_Syntax.sigmeta = + (se.FStar_Syntax_Syntax.sigmeta); + FStar_Syntax_Syntax.sigattrs = + (se.FStar_Syntax_Syntax.sigattrs); + FStar_Syntax_Syntax.sigopens_and_abbrevs + = + (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); + FStar_Syntax_Syntax.sigopts = + (se.FStar_Syntax_Syntax.sigopts) + })))))))) let (tc_tycon : FStar_TypeChecker_Env.env_t -> FStar_Syntax_Syntax.sigelt -> @@ -2570,7 +2588,7 @@ let (check_inductive_well_typedness : let tcs3 = FStar_Compiler_List.map (check_sig_inductive_injectivity_on_params - env1) tcs2 in + env0) tcs2 in let is_injective l = let uu___5 = FStar_Compiler_List.tryPick diff --git a/src/typechecker/FStar.TypeChecker.TcInductive.fst b/src/typechecker/FStar.TypeChecker.TcInductive.fst index 7c5aa867cd0..c88d3fad391 100644 --- a/src/typechecker/FStar.TypeChecker.TcInductive.fst +++ b/src/typechecker/FStar.TypeChecker.TcInductive.fst @@ -48,7 +48,8 @@ let unfold_whnf = N.unfold_whnf' [Env.AllowUnboundUniverses] let check_sig_inductive_injectivity_on_params (tcenv:env_t) (se:sigelt) : sigelt - = let Sig_inductive_typ dd = se.sigel in + = if tcenv.phase1 then se else + let Sig_inductive_typ dd = se.sigel in let { lid=t; us=universe_names; params=tps; t=k } = dd in let t_lid = t in let usubst, uvs = SS.univ_var_opening universe_names in @@ -953,7 +954,7 @@ let check_inductive_well_typedness (env:env_t) (ses:list sigelt) (quals:list qua end | _ -> se) in - let tcs = tcs |> List.map (check_sig_inductive_injectivity_on_params env) in + let tcs = tcs |> List.map (check_sig_inductive_injectivity_on_params env0) in let is_injective l = match List.tryPick From bcbff7cdffae2030d64279d25ff895052a4ab1fb Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Fri, 26 Apr 2024 18:16:33 -0700 Subject: [PATCH 121/239] snap --- .../fstar-lib/generated/FStar_Syntax_DsEnv.ml | 202 +-- .../generated/FStar_Syntax_Resugar.ml | 136 +- .../generated/FStar_Syntax_Syntax.ml | 59 +- .../fstar-lib/generated/FStar_Syntax_Util.ml | 548 ++------ .../generated/FStar_Tactics_Hooks.ml | 7 +- .../generated/FStar_ToSyntax_ToSyntax.ml | 259 ++-- .../generated/FStar_TypeChecker_Common.ml | 887 ------------- .../generated/FStar_TypeChecker_Core.ml | 10 +- .../generated/FStar_TypeChecker_DMFF.ml | 2 +- .../FStar_TypeChecker_DeferredImplicits.ml | 13 +- .../generated/FStar_TypeChecker_Env.ml | 256 ++-- .../generated/FStar_TypeChecker_Normalize.ml | 51 +- .../generated/FStar_TypeChecker_Rel.ml | 254 ++-- .../FStar_TypeChecker_TcInductive.ml | 1101 +++++++++++------ .../generated/FStar_TypeChecker_TcTerm.ml | 21 +- 15 files changed, 1601 insertions(+), 2205 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml b/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml index fde5d3782c3..4ac38fc8917 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml @@ -1176,16 +1176,17 @@ let (fv_qual_of_se : { FStar_Syntax_Syntax.lid1 = uu___; FStar_Syntax_Syntax.us1 = uu___1; FStar_Syntax_Syntax.t1 = uu___2; FStar_Syntax_Syntax.ty_lid = l; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_} + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> let qopt = FStar_Compiler_Util.find_map se.FStar_Syntax_Syntax.sigquals - (fun uu___5 -> - match uu___5 with - | FStar_Syntax_Syntax.RecordConstructor (uu___6, fs) -> + (fun uu___6 -> + match uu___6 with + | FStar_Syntax_Syntax.RecordConstructor (uu___7, fs) -> FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor (l, fs)) - | uu___6 -> FStar_Pervasives_Native.None) in + | uu___7 -> FStar_Pervasives_Native.None) in (match qopt with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor @@ -1898,14 +1899,15 @@ let (find_all_datacons : FStar_Syntax_Syntax.num_uniform_params = uu___4; FStar_Syntax_Syntax.t = uu___5; FStar_Syntax_Syntax.mutuals = datas; - FStar_Syntax_Syntax.ds = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_}, - uu___13) -> FStar_Pervasives_Native.Some datas + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_}, + uu___14) -> FStar_Pervasives_Native.Some datas | uu___1 -> FStar_Pervasives_Native.None in resolve_in_open_namespaces' env1 lid (fun uu___ -> FStar_Pervasives_Native.None) @@ -2015,13 +2017,15 @@ let (extract_record : FStar_Syntax_Syntax.t1 = uu___3; FStar_Syntax_Syntax.ty_lid = uu___4; FStar_Syntax_Syntax.num_ty_params = uu___5; - FStar_Syntax_Syntax.mutuals1 = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_} -> + FStar_Syntax_Syntax.mutuals1 = uu___6; + FStar_Syntax_Syntax.injective_type_params1 = + uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_} -> FStar_Ident.lid_equals dc lid | uu___2 -> false) sigs in FStar_Compiler_List.iter @@ -2036,51 +2040,54 @@ let (extract_record : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = uu___3; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = dc::[];_}; - FStar_Syntax_Syntax.sigrng = uu___5; + FStar_Syntax_Syntax.ds = dc::[]; + FStar_Syntax_Syntax.injective_type_params = uu___5;_}; + FStar_Syntax_Syntax.sigrng = uu___6; FStar_Syntax_Syntax.sigquals = typename_quals; - FStar_Syntax_Syntax.sigmeta = uu___6; - FStar_Syntax_Syntax.sigattrs = uu___7; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___8; - FStar_Syntax_Syntax.sigopts = uu___9;_} -> - let uu___10 = - let uu___11 = find_dc dc in - FStar_Compiler_Util.must uu___11 in - (match uu___10 with + FStar_Syntax_Syntax.sigmeta = uu___7; + FStar_Syntax_Syntax.sigattrs = uu___8; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; + FStar_Syntax_Syntax.sigopts = uu___10;_} -> + let uu___11 = + let uu___12 = find_dc dc in + FStar_Compiler_Util.must uu___12 in + (match uu___11 with | { FStar_Syntax_Syntax.sigel = FStar_Syntax_Syntax.Sig_datacon { FStar_Syntax_Syntax.lid1 = constrname; - FStar_Syntax_Syntax.us1 = uu___11; + FStar_Syntax_Syntax.us1 = uu___12; FStar_Syntax_Syntax.t1 = t; - FStar_Syntax_Syntax.ty_lid = uu___12; + FStar_Syntax_Syntax.ty_lid = uu___13; FStar_Syntax_Syntax.num_ty_params = n; - FStar_Syntax_Syntax.mutuals1 = uu___13;_}; - FStar_Syntax_Syntax.sigrng = uu___14; - FStar_Syntax_Syntax.sigquals = uu___15; - FStar_Syntax_Syntax.sigmeta = uu___16; - FStar_Syntax_Syntax.sigattrs = uu___17; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___18; - FStar_Syntax_Syntax.sigopts = uu___19;_} -> - let uu___20 = FStar_Syntax_Util.arrow_formals t in - (match uu___20 with - | (all_formals, uu___21) -> - let uu___22 = + FStar_Syntax_Syntax.mutuals1 = uu___14; + FStar_Syntax_Syntax.injective_type_params1 = + uu___15;_}; + FStar_Syntax_Syntax.sigrng = uu___16; + FStar_Syntax_Syntax.sigquals = uu___17; + FStar_Syntax_Syntax.sigmeta = uu___18; + FStar_Syntax_Syntax.sigattrs = uu___19; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___20; + FStar_Syntax_Syntax.sigopts = uu___21;_} -> + let uu___22 = FStar_Syntax_Util.arrow_formals t in + (match uu___22 with + | (all_formals, uu___23) -> + let uu___24 = FStar_Compiler_Util.first_N n all_formals in - (match uu___22 with + (match uu___24 with | (_params, formals) -> let is_rec = is_record typename_quals in let formals' = FStar_Compiler_List.collect (fun f -> - let uu___23 = + let uu___25 = (FStar_Syntax_Syntax.is_null_bv f.FStar_Syntax_Syntax.binder_bv) || (is_rec && (FStar_Syntax_Syntax.is_bqual_implicit f.FStar_Syntax_Syntax.binder_qual)) in - if uu___23 then [] else [f]) + if uu___25 then [] else [f]) formals in let fields' = FStar_Compiler_List.map @@ -2090,11 +2097,11 @@ let (extract_record : formals' in let fields = fields' in let record = - let uu___23 = + let uu___25 = FStar_Ident.ident_of_lid constrname in { typename; - constrname = uu___23; + constrname = uu___25; parms; fields; is_private = @@ -2103,41 +2110,41 @@ let (extract_record : typename_quals); is_record = is_rec } in - ((let uu___24 = - let uu___25 = + ((let uu___26 = + let uu___27 = FStar_Compiler_Effect.op_Bang new_globs in - (Record_or_dc record) :: uu___25 in + (Record_or_dc record) :: uu___27 in FStar_Compiler_Effect.op_Colon_Equals - new_globs uu___24); + new_globs uu___26); (match () with | () -> - ((let add_field uu___25 = - match uu___25 with - | (id, uu___26) -> + ((let add_field uu___27 = + match uu___27 with + | (id, uu___28) -> let modul = - let uu___27 = - let uu___28 = + let uu___29 = + let uu___30 = FStar_Ident.ns_of_lid constrname in FStar_Ident.lid_of_ids - uu___28 in + uu___30 in FStar_Ident.string_of_lid - uu___27 in - let uu___27 = + uu___29 in + let uu___29 = get_exported_id_set e modul in - (match uu___27 with + (match uu___29 with | FStar_Pervasives_Native.Some my_ex -> let my_exported_ids = my_ex Exported_id_field in - ((let uu___29 = - let uu___30 = + ((let uu___31 = + let uu___32 = FStar_Ident.string_of_id id in - let uu___31 = + let uu___33 = FStar_Compiler_Effect.op_Bang my_exported_ids in Obj.magic @@ -2146,27 +2153,27 @@ let (extract_record : (Obj.magic (FStar_Compiler_RBSet.setlike_rbset FStar_Class_Ord.ord_string)) - uu___30 + uu___32 (Obj.magic - uu___31)) in + uu___33)) in FStar_Compiler_Effect.op_Colon_Equals my_exported_ids - uu___29); + uu___31); (match () with | () -> let projname = - let uu___29 = - let uu___30 + let uu___31 = + let uu___32 = FStar_Syntax_Util.mk_field_projector_name_from_ident constrname id in FStar_Ident.ident_of_lid - uu___30 in + uu___32 in FStar_Ident.string_of_id - uu___29 in - let uu___30 = - let uu___31 = + uu___31 in + let uu___32 = + let uu___33 = FStar_Compiler_Effect.op_Bang my_exported_ids in Obj.magic @@ -2179,10 +2186,10 @@ let (extract_record : projname ( Obj.magic - uu___31)) in + uu___33)) in FStar_Compiler_Effect.op_Colon_Equals my_exported_ids - uu___30)) + uu___32)) | FStar_Pervasives_Native.None -> ()) in FStar_Compiler_List.iter @@ -2190,7 +2197,7 @@ let (extract_record : (match () with | () -> insert_record_cache record)))))) - | uu___11 -> ()) + | uu___12 -> ()) | uu___2 -> ()) sigs | uu___ -> () let (try_lookup_record_or_dc_by_field_name : @@ -2891,11 +2898,13 @@ let (finish : env -> FStar_Syntax_Syntax.modul -> env) = FStar_Syntax_Syntax.t1 = uu___3; FStar_Syntax_Syntax.ty_lid = uu___4; FStar_Syntax_Syntax.num_ty_params = uu___5; - FStar_Syntax_Syntax.mutuals1 = uu___6;_} + FStar_Syntax_Syntax.mutuals1 = uu___6; + FStar_Syntax_Syntax.injective_type_params1 = + uu___7;_} -> - let uu___7 = FStar_Ident.string_of_lid lid in + let uu___8 = FStar_Ident.string_of_lid lid in FStar_Compiler_Util.smap_remove (sigmap env1) - uu___7 + uu___8 | FStar_Syntax_Syntax.Sig_inductive_typ { FStar_Syntax_Syntax.lid = lid; FStar_Syntax_Syntax.us = univ_names; @@ -2903,36 +2912,39 @@ let (finish : env -> FStar_Syntax_Syntax.modul -> env) = FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = typ; FStar_Syntax_Syntax.mutuals = uu___3; - FStar_Syntax_Syntax.ds = uu___4;_} + FStar_Syntax_Syntax.ds = uu___4; + FStar_Syntax_Syntax.injective_type_params = + uu___5;_} -> - ((let uu___6 = FStar_Ident.string_of_lid lid in + ((let uu___7 = FStar_Ident.string_of_lid lid in FStar_Compiler_Util.smap_remove (sigmap env1) - uu___6); + uu___7); if Prims.op_Negation (FStar_Compiler_List.contains FStar_Syntax_Syntax.Private quals) then (let sigel = - let uu___6 = - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = + let uu___7 = + let uu___8 = + let uu___9 = + let uu___10 = + let uu___11 = FStar_Syntax_Syntax.mk_Total typ in { FStar_Syntax_Syntax.bs1 = binders; - FStar_Syntax_Syntax.comp = uu___10 + FStar_Syntax_Syntax.comp = uu___11 } in - FStar_Syntax_Syntax.Tm_arrow uu___9 in - let uu___9 = FStar_Ident.range_of_lid lid in - FStar_Syntax_Syntax.mk uu___8 uu___9 in + FStar_Syntax_Syntax.Tm_arrow uu___10 in + let uu___10 = + FStar_Ident.range_of_lid lid in + FStar_Syntax_Syntax.mk uu___9 uu___10 in { FStar_Syntax_Syntax.lid2 = lid; FStar_Syntax_Syntax.us2 = univ_names; - FStar_Syntax_Syntax.t2 = uu___7 + FStar_Syntax_Syntax.t2 = uu___8 } in - FStar_Syntax_Syntax.Sig_declare_typ uu___6 in + FStar_Syntax_Syntax.Sig_declare_typ uu___7 in let se2 = { FStar_Syntax_Syntax.sigel = sigel; @@ -2949,9 +2961,9 @@ let (finish : env -> FStar_Syntax_Syntax.modul -> env) = FStar_Syntax_Syntax.sigopts = (se1.FStar_Syntax_Syntax.sigopts) } in - let uu___6 = FStar_Ident.string_of_lid lid in + let uu___7 = FStar_Ident.string_of_lid lid in FStar_Compiler_Util.smap_add (sigmap env1) - uu___6 (se2, false)) + uu___7 (se2, false)) else ()) | uu___2 -> ()) ses else () diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml index 32baefc20fd..bbc0d8cb37d 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml @@ -2378,96 +2378,100 @@ let (resugar_typ : FStar_Syntax_Syntax.num_uniform_params = uu___; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = uu___1; - FStar_Syntax_Syntax.ds = datacons;_} + FStar_Syntax_Syntax.ds = datacons; + FStar_Syntax_Syntax.injective_type_params = uu___2;_} -> - let uu___2 = + let uu___3 = FStar_Compiler_List.partition (fun se1 -> match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_datacon - { FStar_Syntax_Syntax.lid1 = uu___3; - FStar_Syntax_Syntax.us1 = uu___4; - FStar_Syntax_Syntax.t1 = uu___5; + { FStar_Syntax_Syntax.lid1 = uu___4; + FStar_Syntax_Syntax.us1 = uu___5; + FStar_Syntax_Syntax.t1 = uu___6; FStar_Syntax_Syntax.ty_lid = inductive_lid; - FStar_Syntax_Syntax.num_ty_params = uu___6; - FStar_Syntax_Syntax.mutuals1 = uu___7;_} + FStar_Syntax_Syntax.num_ty_params = uu___7; + FStar_Syntax_Syntax.mutuals1 = uu___8; + FStar_Syntax_Syntax.injective_type_params1 = uu___9;_} -> FStar_Ident.lid_equals inductive_lid tylid - | uu___3 -> FStar_Compiler_Effect.failwith "unexpected") + | uu___4 -> FStar_Compiler_Effect.failwith "unexpected") datacon_ses in - (match uu___2 with + (match uu___3 with | (current_datacons, other_datacons) -> let bs1 = - let uu___3 = FStar_Options.print_implicits () in - if uu___3 then bs else filter_imp_bs bs in + let uu___4 = FStar_Options.print_implicits () in + if uu___4 then bs else filter_imp_bs bs in let bs2 = (map_opt ()) (fun b -> resugar_binder' env b t.FStar_Syntax_Syntax.pos) bs1 in let tyc = - let uu___3 = + let uu___4 = FStar_Compiler_Util.for_some - (fun uu___4 -> - match uu___4 with - | FStar_Syntax_Syntax.RecordType uu___5 -> true - | uu___5 -> false) se.FStar_Syntax_Syntax.sigquals in - if uu___3 + (fun uu___5 -> + match uu___5 with + | FStar_Syntax_Syntax.RecordType uu___6 -> true + | uu___6 -> false) se.FStar_Syntax_Syntax.sigquals in + if uu___4 then let resugar_datacon_as_fields fields se1 = match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_datacon - { FStar_Syntax_Syntax.lid1 = uu___4; + { FStar_Syntax_Syntax.lid1 = uu___5; FStar_Syntax_Syntax.us1 = univs; FStar_Syntax_Syntax.t1 = term; - FStar_Syntax_Syntax.ty_lid = uu___5; + FStar_Syntax_Syntax.ty_lid = uu___6; FStar_Syntax_Syntax.num_ty_params = num; - FStar_Syntax_Syntax.mutuals1 = uu___6;_} + FStar_Syntax_Syntax.mutuals1 = uu___7; + FStar_Syntax_Syntax.injective_type_params1 = + uu___8;_} -> - let uu___7 = - let uu___8 = FStar_Syntax_Subst.compress term in - uu___8.FStar_Syntax_Syntax.n in - (match uu___7 with + let uu___9 = + let uu___10 = FStar_Syntax_Subst.compress term in + uu___10.FStar_Syntax_Syntax.n in + (match uu___9 with | FStar_Syntax_Syntax.Tm_arrow { FStar_Syntax_Syntax.bs1 = bs3; - FStar_Syntax_Syntax.comp = uu___8;_} + FStar_Syntax_Syntax.comp = uu___10;_} -> let mfields = FStar_Compiler_List.collect (fun b -> - let uu___9 = + let uu___11 = resugar_bqual env b.FStar_Syntax_Syntax.binder_qual in - match uu___9 with + match uu___11 with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some q -> - let uu___10 = - let uu___11 = + let uu___12 = + let uu___13 = bv_as_unique_ident b.FStar_Syntax_Syntax.binder_bv in - let uu___12 = + let uu___14 = FStar_Compiler_List.map (resugar_term' env) b.FStar_Syntax_Syntax.binder_attrs in - let uu___13 = + let uu___15 = resugar_term' env (b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in - (uu___11, q, uu___12, uu___13) in - [uu___10]) bs3 in + (uu___13, q, uu___14, uu___15) in + [uu___12]) bs3 in FStar_Compiler_List.op_At mfields fields - | uu___8 -> + | uu___10 -> FStar_Compiler_Effect.failwith "unexpected") - | uu___4 -> + | uu___5 -> FStar_Compiler_Effect.failwith "unexpected" in let fields = FStar_Compiler_List.fold_left resugar_datacon_as_fields [] current_datacons in - let uu___4 = - let uu___5 = FStar_Ident.ident_of_lid tylid in - let uu___6 = + let uu___5 = + let uu___6 = FStar_Ident.ident_of_lid tylid in + let uu___7 = FStar_Compiler_List.map (resugar_term' env) se.FStar_Syntax_Syntax.sigattrs in - (uu___5, bs2, FStar_Pervasives_Native.None, uu___6, + (uu___6, bs2, FStar_Pervasives_Native.None, uu___7, fields) in - FStar_Parser_AST.TyconRecord uu___4 + FStar_Parser_AST.TyconRecord uu___5 else (let resugar_datacon constructors se1 = match se1.FStar_Syntax_Syntax.sigel with @@ -2475,32 +2479,34 @@ let (resugar_typ : { FStar_Syntax_Syntax.lid1 = l; FStar_Syntax_Syntax.us1 = univs; FStar_Syntax_Syntax.t1 = term; - FStar_Syntax_Syntax.ty_lid = uu___5; + FStar_Syntax_Syntax.ty_lid = uu___6; FStar_Syntax_Syntax.num_ty_params = num; - FStar_Syntax_Syntax.mutuals1 = uu___6;_} + FStar_Syntax_Syntax.mutuals1 = uu___7; + FStar_Syntax_Syntax.injective_type_params1 = + uu___8;_} -> let c = - let uu___7 = FStar_Ident.ident_of_lid l in - let uu___8 = - let uu___9 = - let uu___10 = resugar_term' env term in - FStar_Parser_AST.VpArbitrary uu___10 in - FStar_Pervasives_Native.Some uu___9 in - let uu___9 = + let uu___9 = FStar_Ident.ident_of_lid l in + let uu___10 = + let uu___11 = + let uu___12 = resugar_term' env term in + FStar_Parser_AST.VpArbitrary uu___12 in + FStar_Pervasives_Native.Some uu___11 in + let uu___11 = FStar_Compiler_List.map (resugar_term' env) se1.FStar_Syntax_Syntax.sigattrs in - (uu___7, uu___8, uu___9) in + (uu___9, uu___10, uu___11) in c :: constructors - | uu___5 -> + | uu___6 -> FStar_Compiler_Effect.failwith "unexpected" in let constructors = FStar_Compiler_List.fold_left resugar_datacon [] current_datacons in - let uu___5 = - let uu___6 = FStar_Ident.ident_of_lid tylid in - (uu___6, bs2, FStar_Pervasives_Native.None, + let uu___6 = + let uu___7 = FStar_Ident.ident_of_lid tylid in + (uu___7, bs2, FStar_Pervasives_Native.None, constructors) in - FStar_Parser_AST.TyconVariant uu___5) in + FStar_Parser_AST.TyconVariant uu___6) in (other_datacons, tyc)) | uu___ -> FStar_Compiler_Effect.failwith @@ -2818,16 +2824,18 @@ let (resugar_sigelt' : FStar_Syntax_Syntax.t1 = uu___4; FStar_Syntax_Syntax.ty_lid = uu___5; FStar_Syntax_Syntax.num_ty_params = uu___6; - FStar_Syntax_Syntax.mutuals1 = uu___7;_} + FStar_Syntax_Syntax.mutuals1 = uu___7; + FStar_Syntax_Syntax.injective_type_params1 = + uu___8;_} -> - let uu___8 = - let uu___9 = - let uu___10 = - let uu___11 = FStar_Ident.ident_of_lid l in - (uu___11, FStar_Pervasives_Native.None) in - FStar_Parser_AST.Exception uu___10 in - decl'_to_decl se1 uu___9 in - FStar_Pervasives_Native.Some uu___8 + let uu___9 = + let uu___10 = + let uu___11 = + let uu___12 = FStar_Ident.ident_of_lid l in + (uu___12, FStar_Pervasives_Native.None) in + FStar_Parser_AST.Exception uu___11 in + decl'_to_decl se1 uu___10 in + FStar_Pervasives_Native.Some uu___9 | uu___3 -> FStar_Compiler_Effect.failwith "wrong format for resguar to Exception") diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml index f7b8282b893..f82c7df57d5 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml @@ -1763,7 +1763,8 @@ type sigelt'__Sig_inductive_typ__payload = num_uniform_params: Prims.int FStar_Pervasives_Native.option ; t: typ ; mutuals: FStar_Ident.lident Prims.list ; - ds: FStar_Ident.lident Prims.list } + ds: FStar_Ident.lident Prims.list ; + injective_type_params: Prims.bool } and sigelt'__Sig_bundle__payload = { ses: sigelt Prims.list ; @@ -1775,7 +1776,8 @@ and sigelt'__Sig_datacon__payload = t1: typ ; ty_lid: FStar_Ident.lident ; num_ty_params: Prims.int ; - mutuals1: FStar_Ident.lident Prims.list } + mutuals1: FStar_Ident.lident Prims.list ; + injective_type_params1: Prims.bool } and sigelt'__Sig_declare_typ__payload = { lid2: FStar_Ident.lident ; @@ -1853,17 +1855,20 @@ let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__lid : sigelt'__Sig_inductive_typ__payload -> FStar_Ident.lident) = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> lid + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> lid let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__us : sigelt'__Sig_inductive_typ__payload -> univ_names) = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> us + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> us let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__params : sigelt'__Sig_inductive_typ__payload -> binders) = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> params + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> params let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__num_uniform_params : sigelt'__Sig_inductive_typ__payload -> @@ -1871,23 +1876,32 @@ let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__num_uniform_params = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> - num_uniform_params + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> num_uniform_params let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__t : sigelt'__Sig_inductive_typ__payload -> typ) = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> t + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> t let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__mutuals : sigelt'__Sig_inductive_typ__payload -> FStar_Ident.lident Prims.list) = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> mutuals + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> mutuals let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__ds : sigelt'__Sig_inductive_typ__payload -> FStar_Ident.lident Prims.list) = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> ds + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> ds +let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__injective_type_params + : sigelt'__Sig_inductive_typ__payload -> Prims.bool) = + fun projectee -> + match projectee with + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> injective_type_params let (__proj__Mksigelt'__Sig_bundle__payload__item__ses : sigelt'__Sig_bundle__payload -> sigelt Prims.list) = fun projectee -> match projectee with | { ses; lids;_} -> ses @@ -1899,37 +1913,50 @@ let (__proj__Mksigelt'__Sig_datacon__payload__item__lid : fun projectee -> match projectee with | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; - mutuals1 = mutuals;_} -> lid + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> lid let (__proj__Mksigelt'__Sig_datacon__payload__item__us : sigelt'__Sig_datacon__payload -> univ_names) = fun projectee -> match projectee with | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; - mutuals1 = mutuals;_} -> us + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> us let (__proj__Mksigelt'__Sig_datacon__payload__item__t : sigelt'__Sig_datacon__payload -> typ) = fun projectee -> match projectee with | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; - mutuals1 = mutuals;_} -> t + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> t let (__proj__Mksigelt'__Sig_datacon__payload__item__ty_lid : sigelt'__Sig_datacon__payload -> FStar_Ident.lident) = fun projectee -> match projectee with | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; - mutuals1 = mutuals;_} -> ty_lid + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> ty_lid let (__proj__Mksigelt'__Sig_datacon__payload__item__num_ty_params : sigelt'__Sig_datacon__payload -> Prims.int) = fun projectee -> match projectee with | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; - mutuals1 = mutuals;_} -> num_ty_params + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> num_ty_params let (__proj__Mksigelt'__Sig_datacon__payload__item__mutuals : sigelt'__Sig_datacon__payload -> FStar_Ident.lident Prims.list) = fun projectee -> match projectee with | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; - mutuals1 = mutuals;_} -> mutuals + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> mutuals +let (__proj__Mksigelt'__Sig_datacon__payload__item__injective_type_params : + sigelt'__Sig_datacon__payload -> Prims.bool) = + fun projectee -> + match projectee with + | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> injective_type_params let (__proj__Mksigelt'__Sig_declare_typ__payload__item__lid : sigelt'__Sig_declare_typ__payload -> FStar_Ident.lident) = fun projectee -> diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml index 20d9ecd64ad..f8dd7bd99de 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml @@ -382,6 +382,14 @@ let (eq_univs : = fun u1 -> fun u2 -> let uu___ = compare_univs u1 u2 in uu___ = Prims.int_zero +let (eq_univs_list : + FStar_Syntax_Syntax.universes -> + FStar_Syntax_Syntax.universes -> Prims.bool) + = + fun us -> + fun vs -> + ((FStar_Compiler_List.length us) = (FStar_Compiler_List.length vs)) && + (FStar_Compiler_List.forall2 eq_univs us vs) let (ml_comp : FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> FStar_Compiler_Range_Type.range -> FStar_Syntax_Syntax.comp) @@ -929,418 +937,6 @@ let (canon_app : match uu___ with | (hd, args) -> FStar_Syntax_Syntax.mk_Tm_app hd args t.FStar_Syntax_Syntax.pos -type eq_result = - | Equal - | NotEqual - | Unknown -let (uu___is_Equal : eq_result -> Prims.bool) = - fun projectee -> match projectee with | Equal -> true | uu___ -> false -let (uu___is_NotEqual : eq_result -> Prims.bool) = - fun projectee -> match projectee with | NotEqual -> true | uu___ -> false -let (uu___is_Unknown : eq_result -> Prims.bool) = - fun projectee -> match projectee with | Unknown -> true | uu___ -> false -let (injectives : Prims.string Prims.list) = - ["FStar.Int8.int_to_t"; - "FStar.Int16.int_to_t"; - "FStar.Int32.int_to_t"; - "FStar.Int64.int_to_t"; - "FStar.Int128.int_to_t"; - "FStar.UInt8.uint_to_t"; - "FStar.UInt16.uint_to_t"; - "FStar.UInt32.uint_to_t"; - "FStar.UInt64.uint_to_t"; - "FStar.UInt128.uint_to_t"; - "FStar.SizeT.uint_to_t"; - "FStar.Int8.__int_to_t"; - "FStar.Int16.__int_to_t"; - "FStar.Int32.__int_to_t"; - "FStar.Int64.__int_to_t"; - "FStar.Int128.__int_to_t"; - "FStar.UInt8.__uint_to_t"; - "FStar.UInt16.__uint_to_t"; - "FStar.UInt32.__uint_to_t"; - "FStar.UInt64.__uint_to_t"; - "FStar.UInt128.__uint_to_t"; - "FStar.SizeT.__uint_to_t"] -let (eq_inj : eq_result -> eq_result -> eq_result) = - fun r -> - fun s -> - match (r, s) with - | (Equal, Equal) -> Equal - | (NotEqual, uu___) -> NotEqual - | (uu___, NotEqual) -> NotEqual - | (uu___, uu___1) -> Unknown -let (equal_if : Prims.bool -> eq_result) = - fun uu___ -> if uu___ then Equal else Unknown -let (equal_iff : Prims.bool -> eq_result) = - fun uu___ -> if uu___ then Equal else NotEqual -let (eq_and : eq_result -> (unit -> eq_result) -> eq_result) = - fun r -> - fun s -> - let uu___ = (r = Equal) && (let uu___1 = s () in uu___1 = Equal) in - if uu___ then Equal else Unknown -let rec (eq_tm : - FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> eq_result) = - fun t1 -> - fun t2 -> - let t11 = canon_app t1 in - let t21 = canon_app t2 in - let equal_data f1 args1 f2 args2 = - let uu___ = FStar_Syntax_Syntax.fv_eq f1 f2 in - if uu___ - then - let uu___1 = FStar_Compiler_List.zip args1 args2 in - FStar_Compiler_List.fold_left - (fun acc -> - fun uu___2 -> - match uu___2 with - | ((a1, q1), (a2, q2)) -> - let uu___3 = eq_tm a1 a2 in eq_inj acc uu___3) Equal - uu___1 - else NotEqual in - let qual_is_inj uu___ = - match uu___ with - | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Data_ctor) -> - true - | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor - uu___1) -> true - | uu___1 -> false in - let heads_and_args_in_case_both_data = - let uu___ = let uu___1 = unmeta t11 in head_and_args uu___1 in - match uu___ with - | (head1, args1) -> - let uu___1 = let uu___2 = unmeta t21 in head_and_args uu___2 in - (match uu___1 with - | (head2, args2) -> - let uu___2 = - let uu___3 = - let uu___4 = un_uinst head1 in - uu___4.FStar_Syntax_Syntax.n in - let uu___4 = - let uu___5 = un_uinst head2 in - uu___5.FStar_Syntax_Syntax.n in - (uu___3, uu___4) in - (match uu___2 with - | (FStar_Syntax_Syntax.Tm_fvar f, - FStar_Syntax_Syntax.Tm_fvar g) when - (qual_is_inj f.FStar_Syntax_Syntax.fv_qual) && - (qual_is_inj g.FStar_Syntax_Syntax.fv_qual) - -> FStar_Pervasives_Native.Some (f, args1, g, args2) - | uu___3 -> FStar_Pervasives_Native.None)) in - let t12 = unmeta t11 in - let t22 = unmeta t21 in - match ((t12.FStar_Syntax_Syntax.n), (t22.FStar_Syntax_Syntax.n)) with - | (FStar_Syntax_Syntax.Tm_bvar bv1, FStar_Syntax_Syntax.Tm_bvar bv2) -> - equal_if - (bv1.FStar_Syntax_Syntax.index = bv2.FStar_Syntax_Syntax.index) - | (FStar_Syntax_Syntax.Tm_lazy uu___, uu___1) -> - let uu___2 = unlazy t12 in eq_tm uu___2 t22 - | (uu___, FStar_Syntax_Syntax.Tm_lazy uu___1) -> - let uu___2 = unlazy t22 in eq_tm t12 uu___2 - | (FStar_Syntax_Syntax.Tm_name a, FStar_Syntax_Syntax.Tm_name b) -> - let uu___ = FStar_Syntax_Syntax.bv_eq a b in equal_if uu___ - | uu___ when - FStar_Compiler_Util.is_some heads_and_args_in_case_both_data -> - let uu___1 = - FStar_Compiler_Util.must heads_and_args_in_case_both_data in - (match uu___1 with - | (f, args1, g, args2) -> equal_data f args1 g args2) - | (FStar_Syntax_Syntax.Tm_fvar f, FStar_Syntax_Syntax.Tm_fvar g) -> - let uu___ = FStar_Syntax_Syntax.fv_eq f g in equal_if uu___ - | (FStar_Syntax_Syntax.Tm_uinst (f, us), FStar_Syntax_Syntax.Tm_uinst - (g, vs)) -> - let uu___ = eq_tm f g in - eq_and uu___ - (fun uu___1 -> - let uu___2 = eq_univs_list us vs in equal_if uu___2) - | (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range uu___), - FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range uu___1)) -> - Unknown - | (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_real r1), - FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_real r2)) -> - equal_if (r1 = r2) - | (FStar_Syntax_Syntax.Tm_constant c, FStar_Syntax_Syntax.Tm_constant - d) -> let uu___ = FStar_Const.eq_const c d in equal_iff uu___ - | (FStar_Syntax_Syntax.Tm_uvar (u1, ([], uu___)), - FStar_Syntax_Syntax.Tm_uvar (u2, ([], uu___1))) -> - let uu___2 = - FStar_Syntax_Unionfind.equiv u1.FStar_Syntax_Syntax.ctx_uvar_head - u2.FStar_Syntax_Syntax.ctx_uvar_head in - equal_if uu___2 - | (FStar_Syntax_Syntax.Tm_app - { FStar_Syntax_Syntax.hd = h1; FStar_Syntax_Syntax.args = args1;_}, - FStar_Syntax_Syntax.Tm_app - { FStar_Syntax_Syntax.hd = h2; FStar_Syntax_Syntax.args = args2;_}) - -> - let uu___ = - let uu___1 = - let uu___2 = un_uinst h1 in uu___2.FStar_Syntax_Syntax.n in - let uu___2 = - let uu___3 = un_uinst h2 in uu___3.FStar_Syntax_Syntax.n in - (uu___1, uu___2) in - (match uu___ with - | (FStar_Syntax_Syntax.Tm_fvar f1, FStar_Syntax_Syntax.Tm_fvar f2) - when - (FStar_Syntax_Syntax.fv_eq f1 f2) && - (let uu___1 = - let uu___2 = FStar_Syntax_Syntax.lid_of_fv f1 in - FStar_Ident.string_of_lid uu___2 in - FStar_Compiler_List.mem uu___1 injectives) - -> equal_data f1 args1 f2 args2 - | uu___1 -> - let uu___2 = eq_tm h1 h2 in - eq_and uu___2 (fun uu___3 -> eq_args args1 args2)) - | (FStar_Syntax_Syntax.Tm_match - { FStar_Syntax_Syntax.scrutinee = t13; - FStar_Syntax_Syntax.ret_opt = uu___; - FStar_Syntax_Syntax.brs = bs1; - FStar_Syntax_Syntax.rc_opt1 = uu___1;_}, - FStar_Syntax_Syntax.Tm_match - { FStar_Syntax_Syntax.scrutinee = t23; - FStar_Syntax_Syntax.ret_opt = uu___2; - FStar_Syntax_Syntax.brs = bs2; - FStar_Syntax_Syntax.rc_opt1 = uu___3;_}) - -> - if - (FStar_Compiler_List.length bs1) = - (FStar_Compiler_List.length bs2) - then - let uu___4 = FStar_Compiler_List.zip bs1 bs2 in - let uu___5 = eq_tm t13 t23 in - FStar_Compiler_List.fold_right - (fun uu___6 -> - fun a -> - match uu___6 with - | (b1, b2) -> - eq_and a (fun uu___7 -> branch_matches b1 b2)) uu___4 - uu___5 - else Unknown - | (FStar_Syntax_Syntax.Tm_type u, FStar_Syntax_Syntax.Tm_type v) -> - let uu___ = eq_univs u v in equal_if uu___ - | (FStar_Syntax_Syntax.Tm_quoted (t13, q1), - FStar_Syntax_Syntax.Tm_quoted (t23, q2)) -> Unknown - | (FStar_Syntax_Syntax.Tm_refine - { FStar_Syntax_Syntax.b = t13; FStar_Syntax_Syntax.phi = phi1;_}, - FStar_Syntax_Syntax.Tm_refine - { FStar_Syntax_Syntax.b = t23; FStar_Syntax_Syntax.phi = phi2;_}) -> - let uu___ = - eq_tm t13.FStar_Syntax_Syntax.sort t23.FStar_Syntax_Syntax.sort in - eq_and uu___ (fun uu___1 -> eq_tm phi1 phi2) - | (FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = bs1; FStar_Syntax_Syntax.body = body1; - FStar_Syntax_Syntax.rc_opt = uu___;_}, - FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = bs2; FStar_Syntax_Syntax.body = body2; - FStar_Syntax_Syntax.rc_opt = uu___1;_}) - when - (FStar_Compiler_List.length bs1) = (FStar_Compiler_List.length bs2) - -> - let uu___2 = - FStar_Compiler_List.fold_left2 - (fun r -> - fun b1 -> - fun b2 -> - eq_and r - (fun uu___3 -> - eq_tm - (b1.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort - (b2.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort)) - Equal bs1 bs2 in - eq_and uu___2 (fun uu___3 -> eq_tm body1 body2) - | (FStar_Syntax_Syntax.Tm_arrow - { FStar_Syntax_Syntax.bs1 = bs1; FStar_Syntax_Syntax.comp = c1;_}, - FStar_Syntax_Syntax.Tm_arrow - { FStar_Syntax_Syntax.bs1 = bs2; FStar_Syntax_Syntax.comp = c2;_}) - when - (FStar_Compiler_List.length bs1) = (FStar_Compiler_List.length bs2) - -> - let uu___ = - FStar_Compiler_List.fold_left2 - (fun r -> - fun b1 -> - fun b2 -> - eq_and r - (fun uu___1 -> - eq_tm - (b1.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort - (b2.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort)) - Equal bs1 bs2 in - eq_and uu___ (fun uu___1 -> eq_comp c1 c2) - | uu___ -> Unknown -and (eq_antiquotations : - FStar_Syntax_Syntax.term Prims.list -> - FStar_Syntax_Syntax.term Prims.list -> eq_result) - = - fun a1 -> - fun a2 -> - match (a1, a2) with - | ([], []) -> Equal - | ([], uu___) -> NotEqual - | (uu___, []) -> NotEqual - | (t1::a11, t2::a21) -> - let uu___ = eq_tm t1 t2 in - (match uu___ with - | NotEqual -> NotEqual - | Unknown -> - let uu___1 = eq_antiquotations a11 a21 in - (match uu___1 with | NotEqual -> NotEqual | uu___2 -> Unknown) - | Equal -> eq_antiquotations a11 a21) -and (branch_matches : - (FStar_Syntax_Syntax.pat' FStar_Syntax_Syntax.withinfo_t * - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax - FStar_Pervasives_Native.option * FStar_Syntax_Syntax.term' - FStar_Syntax_Syntax.syntax) -> - (FStar_Syntax_Syntax.pat' FStar_Syntax_Syntax.withinfo_t * - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax - FStar_Pervasives_Native.option * FStar_Syntax_Syntax.term' - FStar_Syntax_Syntax.syntax) -> eq_result) - = - fun b1 -> - fun b2 -> - let related_by f o1 o2 = - match (o1, o2) with - | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> - true - | (FStar_Pervasives_Native.Some x, FStar_Pervasives_Native.Some y) -> - f x y - | (uu___, uu___1) -> false in - let uu___ = b1 in - match uu___ with - | (p1, w1, t1) -> - let uu___1 = b2 in - (match uu___1 with - | (p2, w2, t2) -> - let uu___2 = FStar_Syntax_Syntax.eq_pat p1 p2 in - if uu___2 - then - let uu___3 = - (let uu___4 = eq_tm t1 t2 in uu___4 = Equal) && - (related_by - (fun t11 -> - fun t21 -> - let uu___4 = eq_tm t11 t21 in uu___4 = Equal) w1 - w2) in - (if uu___3 then Equal else Unknown) - else Unknown) -and (eq_args : - FStar_Syntax_Syntax.args -> FStar_Syntax_Syntax.args -> eq_result) = - fun a1 -> - fun a2 -> - match (a1, a2) with - | ([], []) -> Equal - | ((a, uu___)::a11, (b, uu___1)::b1) -> - let uu___2 = eq_tm a b in - (match uu___2 with | Equal -> eq_args a11 b1 | uu___3 -> Unknown) - | uu___ -> Unknown -and (eq_univs_list : - FStar_Syntax_Syntax.universes -> - FStar_Syntax_Syntax.universes -> Prims.bool) - = - fun us -> - fun vs -> - ((FStar_Compiler_List.length us) = (FStar_Compiler_List.length vs)) && - (FStar_Compiler_List.forall2 eq_univs us vs) -and (eq_comp : - FStar_Syntax_Syntax.comp -> FStar_Syntax_Syntax.comp -> eq_result) = - fun c1 -> - fun c2 -> - match ((c1.FStar_Syntax_Syntax.n), (c2.FStar_Syntax_Syntax.n)) with - | (FStar_Syntax_Syntax.Total t1, FStar_Syntax_Syntax.Total t2) -> - eq_tm t1 t2 - | (FStar_Syntax_Syntax.GTotal t1, FStar_Syntax_Syntax.GTotal t2) -> - eq_tm t1 t2 - | (FStar_Syntax_Syntax.Comp ct1, FStar_Syntax_Syntax.Comp ct2) -> - let uu___ = - let uu___1 = - eq_univs_list ct1.FStar_Syntax_Syntax.comp_univs - ct2.FStar_Syntax_Syntax.comp_univs in - equal_if uu___1 in - eq_and uu___ - (fun uu___1 -> - let uu___2 = - let uu___3 = - FStar_Ident.lid_equals ct1.FStar_Syntax_Syntax.effect_name - ct2.FStar_Syntax_Syntax.effect_name in - equal_if uu___3 in - eq_and uu___2 - (fun uu___3 -> - let uu___4 = - eq_tm ct1.FStar_Syntax_Syntax.result_typ - ct2.FStar_Syntax_Syntax.result_typ in - eq_and uu___4 - (fun uu___5 -> - eq_args ct1.FStar_Syntax_Syntax.effect_args - ct2.FStar_Syntax_Syntax.effect_args))) - | uu___ -> NotEqual -let (eq_quoteinfo : - FStar_Syntax_Syntax.quoteinfo -> FStar_Syntax_Syntax.quoteinfo -> eq_result) - = - fun q1 -> - fun q2 -> - if q1.FStar_Syntax_Syntax.qkind <> q2.FStar_Syntax_Syntax.qkind - then NotEqual - else - eq_antiquotations - (FStar_Pervasives_Native.snd q1.FStar_Syntax_Syntax.antiquotations) - (FStar_Pervasives_Native.snd q2.FStar_Syntax_Syntax.antiquotations) -let (eq_bqual : - FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> - FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> - eq_result) - = - fun a1 -> - fun a2 -> - match (a1, a2) with - | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> Equal - | (FStar_Pervasives_Native.None, uu___) -> NotEqual - | (uu___, FStar_Pervasives_Native.None) -> NotEqual - | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit b1), - FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit b2)) when - b1 = b2 -> Equal - | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Meta t1), - FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Meta t2)) -> - eq_tm t1 t2 - | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Equality), - FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Equality)) -> - Equal - | uu___ -> NotEqual -let (eq_aqual : - FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> - FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> - eq_result) - = - fun a1 -> - fun a2 -> - match (a1, a2) with - | (FStar_Pervasives_Native.Some a11, FStar_Pervasives_Native.Some a21) - -> - if - (a11.FStar_Syntax_Syntax.aqual_implicit = - a21.FStar_Syntax_Syntax.aqual_implicit) - && - ((FStar_Compiler_List.length - a11.FStar_Syntax_Syntax.aqual_attributes) - = - (FStar_Compiler_List.length - a21.FStar_Syntax_Syntax.aqual_attributes)) - then - FStar_Compiler_List.fold_left2 - (fun out -> - fun t1 -> - fun t2 -> - match out with - | NotEqual -> out - | Unknown -> - let uu___ = eq_tm t1 t2 in - (match uu___ with - | NotEqual -> NotEqual - | uu___1 -> Unknown) - | Equal -> eq_tm t1 t2) Equal - a11.FStar_Syntax_Syntax.aqual_attributes - a21.FStar_Syntax_Syntax.aqual_attributes - else NotEqual - | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> Equal - | uu___ -> NotEqual let rec (unrefine : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term) = fun t -> let t1 = FStar_Syntax_Subst.compress t in @@ -1469,7 +1065,8 @@ let (lids_of_sigelt : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = uu___3; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> [lid] | FStar_Syntax_Syntax.Sig_effect_abbrev { FStar_Syntax_Syntax.lid4 = lid; FStar_Syntax_Syntax.us4 = uu___; @@ -1482,7 +1079,8 @@ let (lids_of_sigelt : FStar_Syntax_Syntax.t1 = uu___1; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_} + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> [lid] | FStar_Syntax_Syntax.Sig_declare_typ { FStar_Syntax_Syntax.lid2 = lid; FStar_Syntax_Syntax.us2 = uu___; @@ -2339,12 +1937,6 @@ let (type_with_u : FStar_Syntax_Syntax.universe -> FStar_Syntax_Syntax.typ) = fun u -> FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_type u) FStar_Compiler_Range_Type.dummyRange -let (attr_eq : - FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> Prims.bool) = - fun a -> - fun a' -> - let uu___ = eq_tm a a' in - match uu___ with | Equal -> true | uu___1 -> false let (attr_substitute : FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax) = let uu___ = @@ -3591,7 +3183,7 @@ let rec (term_eq_dbg : u2.FStar_Syntax_Syntax.ctx_uvar_head) | (FStar_Syntax_Syntax.Tm_quoted (qt1, qi1), FStar_Syntax_Syntax.Tm_quoted (qt2, qi2)) -> - (let uu___1 = let uu___2 = eq_quoteinfo qi1 qi2 in uu___2 = Equal in + (let uu___1 = quote_info_eq_dbg dbg qi1 qi2 in check1 "tm_quoted qi" uu___1) && (let uu___1 = term_eq_dbg dbg qt1 qt2 in check1 "tm_quoted payload" uu___1) @@ -3662,7 +3254,7 @@ and (arg_eq_dbg : let uu___ = term_eq_dbg dbg t1 t2 in check dbg "arg tm" uu___) (fun q1 -> fun q2 -> - let uu___ = let uu___1 = eq_aqual q1 q2 in uu___1 = Equal in + let uu___ = aqual_eq_dbg dbg q1 q2 in check dbg "arg qual" uu___) a1 a2 and (binder_eq_dbg : Prims.bool -> @@ -3677,10 +3269,8 @@ and (binder_eq_dbg : (b2.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in check dbg "binder_sort" uu___) && (let uu___ = - let uu___1 = - eq_bqual b1.FStar_Syntax_Syntax.binder_qual - b2.FStar_Syntax_Syntax.binder_qual in - uu___1 = Equal in + bqual_eq_dbg dbg b1.FStar_Syntax_Syntax.binder_qual + b2.FStar_Syntax_Syntax.binder_qual in check dbg "binder qual" uu___)) && (let uu___ = @@ -3756,6 +3346,108 @@ and (letbinding_eq_dbg : term_eq_dbg dbg lb1.FStar_Syntax_Syntax.lbdef lb2.FStar_Syntax_Syntax.lbdef in check dbg "lb def" uu___) +and (quote_info_eq_dbg : + Prims.bool -> + FStar_Syntax_Syntax.quoteinfo -> + FStar_Syntax_Syntax.quoteinfo -> Prims.bool) + = + fun dbg -> + fun q1 -> + fun q2 -> + if q1.FStar_Syntax_Syntax.qkind <> q2.FStar_Syntax_Syntax.qkind + then false + else + antiquotations_eq_dbg dbg + (FStar_Pervasives_Native.snd + q1.FStar_Syntax_Syntax.antiquotations) + (FStar_Pervasives_Native.snd + q2.FStar_Syntax_Syntax.antiquotations) +and (antiquotations_eq_dbg : + Prims.bool -> + FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax Prims.list -> + FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax Prims.list -> + Prims.bool) + = + fun dbg -> + fun a1 -> + fun a2 -> + match (a1, a2) with + | ([], []) -> true + | ([], uu___) -> false + | (uu___, []) -> false + | (t1::a11, t2::a21) -> + let uu___ = + let uu___1 = term_eq_dbg dbg t1 t2 in Prims.op_Negation uu___1 in + if uu___ then false else antiquotations_eq_dbg dbg a11 a21 +and (bqual_eq_dbg : + Prims.bool -> + FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> + FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> + Prims.bool) + = + fun dbg -> + fun a1 -> + fun a2 -> + match (a1, a2) with + | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> + true + | (FStar_Pervasives_Native.None, uu___) -> false + | (uu___, FStar_Pervasives_Native.None) -> false + | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit b1), + FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit b2)) + when b1 = b2 -> true + | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Meta t1), + FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Meta t2)) -> + term_eq_dbg dbg t1 t2 + | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Equality), + FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Equality)) -> + true + | uu___ -> false +and (aqual_eq_dbg : + Prims.bool -> + FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> + FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> + Prims.bool) + = + fun dbg -> + fun a1 -> + fun a2 -> + match (a1, a2) with + | (FStar_Pervasives_Native.Some a11, FStar_Pervasives_Native.Some + a21) -> + if + (a11.FStar_Syntax_Syntax.aqual_implicit = + a21.FStar_Syntax_Syntax.aqual_implicit) + && + ((FStar_Compiler_List.length + a11.FStar_Syntax_Syntax.aqual_attributes) + = + (FStar_Compiler_List.length + a21.FStar_Syntax_Syntax.aqual_attributes)) + then + FStar_Compiler_List.fold_left2 + (fun out -> + fun t1 -> + fun t2 -> + if Prims.op_Negation out + then false + else term_eq_dbg dbg t1 t2) true + a11.FStar_Syntax_Syntax.aqual_attributes + a21.FStar_Syntax_Syntax.aqual_attributes + else false + | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> + true + | uu___ -> false +let (eq_aqual : + FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> + FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> + Prims.bool) + = fun a1 -> fun a2 -> aqual_eq_dbg false a1 a2 +let (eq_bqual : + FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> + FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> + Prims.bool) + = fun b1 -> fun b2 -> bqual_eq_dbg false b1 b2 let (term_eq : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> Prims.bool) = fun t1 -> @@ -4845,9 +4537,7 @@ let (is_binder_unused : FStar_Syntax_Syntax.binder -> Prims.bool) = let (deduplicate_terms : FStar_Syntax_Syntax.term Prims.list -> FStar_Syntax_Syntax.term Prims.list) = - fun l -> - FStar_Compiler_List.deduplicate - (fun x -> fun y -> let uu___ = eq_tm x y in uu___ = Equal) l + fun l -> FStar_Compiler_List.deduplicate (fun x -> fun y -> term_eq x y) l let (eq_binding : FStar_Syntax_Syntax.binding -> FStar_Syntax_Syntax.binding -> Prims.bool) = fun b1 -> diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml index 33dae4e4ca6..898674ac524 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml @@ -1261,9 +1261,10 @@ let rec (traverse_for_spinoff : FStar_Parser_Const.squash_lid)) && (let uu___8 = - FStar_Syntax_Util.eq_tm t2 - FStar_Syntax_Util.t_true in - uu___8 = FStar_Syntax_Util.Equal) + FStar_TypeChecker_TermEqAndSimplify.eq_tm + e t2 FStar_Syntax_Util.t_true in + uu___8 = + FStar_TypeChecker_TermEqAndSimplify.Equal) -> (if debug then diff --git a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml index 959617fa399..372ae31b33b 100644 --- a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml +++ b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml @@ -1052,30 +1052,33 @@ let rec (generalize_annotated_univs : FStar_Syntax_Syntax.num_uniform_params = num_uniform; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = lids1; - FStar_Syntax_Syntax.ds = lids2;_} + FStar_Syntax_Syntax.ds = lids2; + FStar_Syntax_Syntax.injective_type_params = uu___5;_} -> - let uu___5 = - let uu___6 = - let uu___7 = - FStar_Syntax_Subst.subst_binders usubst bs in + let uu___6 = + let uu___7 = let uu___8 = - let uu___9 = + FStar_Syntax_Subst.subst_binders usubst bs in + let uu___9 = + let uu___10 = FStar_Syntax_Subst.shift_subst (FStar_Compiler_List.length bs) usubst in - FStar_Syntax_Subst.subst uu___9 t in + FStar_Syntax_Subst.subst uu___10 t in { FStar_Syntax_Syntax.lid = lid; FStar_Syntax_Syntax.us = unames; - FStar_Syntax_Syntax.params = uu___7; + FStar_Syntax_Syntax.params = uu___8; FStar_Syntax_Syntax.num_uniform_params = num_uniform; - FStar_Syntax_Syntax.t = uu___8; + FStar_Syntax_Syntax.t = uu___9; FStar_Syntax_Syntax.mutuals = lids1; - FStar_Syntax_Syntax.ds = lids2 + FStar_Syntax_Syntax.ds = lids2; + FStar_Syntax_Syntax.injective_type_params = + false } in - FStar_Syntax_Syntax.Sig_inductive_typ uu___6 in + FStar_Syntax_Syntax.Sig_inductive_typ uu___7 in { - FStar_Syntax_Syntax.sigel = uu___5; + FStar_Syntax_Syntax.sigel = uu___6; FStar_Syntax_Syntax.sigrng = (se.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = @@ -1095,22 +1098,25 @@ let rec (generalize_annotated_univs : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = tlid; FStar_Syntax_Syntax.num_ty_params = n; - FStar_Syntax_Syntax.mutuals1 = lids1;_} + FStar_Syntax_Syntax.mutuals1 = lids1; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> - let uu___5 = - let uu___6 = - let uu___7 = FStar_Syntax_Subst.subst usubst t in + let uu___6 = + let uu___7 = + let uu___8 = FStar_Syntax_Subst.subst usubst t in { FStar_Syntax_Syntax.lid1 = lid; FStar_Syntax_Syntax.us1 = unames; - FStar_Syntax_Syntax.t1 = uu___7; + FStar_Syntax_Syntax.t1 = uu___8; FStar_Syntax_Syntax.ty_lid = tlid; FStar_Syntax_Syntax.num_ty_params = n; - FStar_Syntax_Syntax.mutuals1 = lids1 + FStar_Syntax_Syntax.mutuals1 = lids1; + FStar_Syntax_Syntax.injective_type_params1 = + false } in - FStar_Syntax_Syntax.Sig_datacon uu___6 in + FStar_Syntax_Syntax.Sig_datacon uu___7 in { - FStar_Syntax_Syntax.sigel = uu___5; + FStar_Syntax_Syntax.sigel = uu___6; FStar_Syntax_Syntax.sigrng = (se.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = @@ -6497,32 +6503,33 @@ let (mk_data_projector_names : FStar_Syntax_Syntax.us1 = uu___; FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___1; FStar_Syntax_Syntax.num_ty_params = n; - FStar_Syntax_Syntax.mutuals1 = uu___2;_} + FStar_Syntax_Syntax.mutuals1 = uu___2; + FStar_Syntax_Syntax.injective_type_params1 = uu___3;_} -> - let uu___3 = FStar_Syntax_Util.arrow_formals t in - (match uu___3 with - | (formals, uu___4) -> + let uu___4 = FStar_Syntax_Util.arrow_formals t in + (match uu___4 with + | (formals, uu___5) -> (match formals with | [] -> [] - | uu___5 -> - let filter_records uu___6 = - match uu___6 with + | uu___6 -> + let filter_records uu___7 = + match uu___7 with | FStar_Syntax_Syntax.RecordConstructor - (uu___7, fns) -> + (uu___8, fns) -> FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor (lid, fns)) - | uu___7 -> FStar_Pervasives_Native.None in + | uu___8 -> FStar_Pervasives_Native.None in let fv_qual = - let uu___6 = + let uu___7 = FStar_Compiler_Util.find_map se.FStar_Syntax_Syntax.sigquals filter_records in - match uu___6 with + match uu___7 with | FStar_Pervasives_Native.None -> FStar_Syntax_Syntax.Data_ctor | FStar_Pervasives_Native.Some q -> q in - let uu___6 = FStar_Compiler_Util.first_N n formals in - (match uu___6 with - | (uu___7, rest) -> + let uu___7 = FStar_Compiler_Util.first_N n formals in + (match uu___7 with + | (uu___8, rest) -> mk_indexed_projector_names iquals fv_qual se.FStar_Syntax_Syntax.sigattrs env lid rest))) | uu___ -> []) @@ -6908,7 +6915,9 @@ let rec (desugar_tycon : FStar_Pervasives_Native.None; FStar_Syntax_Syntax.t = k1; FStar_Syntax_Syntax.mutuals = mutuals; - FStar_Syntax_Syntax.ds = [] + FStar_Syntax_Syntax.ds = []; + FStar_Syntax_Syntax.injective_type_params = + false }); FStar_Syntax_Syntax.sigrng = uu___2; FStar_Syntax_Syntax.sigquals = quals1; @@ -6974,7 +6983,9 @@ let rec (desugar_tycon : FStar_Syntax_Syntax.num_uniform_params = uu___5; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = []; - FStar_Syntax_Syntax.ds = [];_} + FStar_Syntax_Syntax.ds = []; + FStar_Syntax_Syntax.injective_type_params = + uu___6;_} -> let quals1 = se.FStar_Syntax_Syntax.sigquals in let quals2 = @@ -6983,22 +6994,22 @@ let rec (desugar_tycon : FStar_Syntax_Syntax.Assumption quals1 then quals1 else - ((let uu___8 = - let uu___9 = FStar_Options.ml_ish () in - Prims.op_Negation uu___9 in - if uu___8 + ((let uu___9 = + let uu___10 = FStar_Options.ml_ish () in + Prims.op_Negation uu___10 in + if uu___9 then - let uu___9 = - let uu___10 = - let uu___11 = + let uu___10 = + let uu___11 = + let uu___12 = FStar_Syntax_Print.lid_to_string l in FStar_Compiler_Util.format1 "Adding an implicit 'assume new' qualifier on %s" - uu___11 in + uu___12 in (FStar_Errors_Codes.Warning_AddImplicitAssumeNewQualifier, - uu___10) in + uu___11) in FStar_Errors.log_issue - se.FStar_Syntax_Syntax.sigrng uu___9 + se.FStar_Syntax_Syntax.sigrng uu___10 else ()); FStar_Syntax_Syntax.Assumption :: @@ -7008,17 +7019,17 @@ let rec (desugar_tycon : let t = match typars with | [] -> k - | uu___6 -> - let uu___7 = - let uu___8 = - let uu___9 = + | uu___7 -> + let uu___8 = + let uu___9 = + let uu___10 = FStar_Syntax_Syntax.mk_Total k in { FStar_Syntax_Syntax.bs1 = typars; - FStar_Syntax_Syntax.comp = uu___9 + FStar_Syntax_Syntax.comp = uu___10 } in - FStar_Syntax_Syntax.Tm_arrow uu___8 in - FStar_Syntax_Syntax.mk uu___7 + FStar_Syntax_Syntax.Tm_arrow uu___9 in + FStar_Syntax_Syntax.mk uu___8 se.FStar_Syntax_Syntax.sigrng in { FStar_Syntax_Syntax.sigel = @@ -7257,37 +7268,39 @@ let rec (desugar_tycon : = uu___4; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params + = uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; FStar_Syntax_Syntax.sigopens_and_abbrevs = - uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_}, + uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_}, binders, t, quals1) -> let t1 = - let uu___13 = + let uu___14 = typars_of_binders env1 binders in - match uu___13 with + match uu___14 with | (env2, tpars1) -> - let uu___14 = push_tparams env2 tpars1 in - (match uu___14 with + let uu___15 = push_tparams env2 tpars1 in + (match uu___15 with | (env_tps, tpars2) -> let t2 = desugar_typ env_tps t in let tpars3 = FStar_Syntax_Subst.close_binders tpars2 in FStar_Syntax_Subst.close tpars3 t2) in - let uu___13 = - let uu___14 = - let uu___15 = FStar_Ident.range_of_lid id in + let uu___14 = + let uu___15 = + let uu___16 = FStar_Ident.range_of_lid id in mk_typ_abbrev env1 d id uvs tpars (FStar_Pervasives_Native.Some k) t1 - [id] quals1 uu___15 in - ([], uu___14) in - [uu___13] + [id] quals1 uu___16 in + ([], uu___15) in + [uu___14] | FStar_Pervasives.Inl ({ FStar_Syntax_Syntax.sigel = @@ -7299,7 +7312,9 @@ let rec (desugar_tycon : = num_uniform; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = mutuals1; - FStar_Syntax_Syntax.ds = uu___4;_}; + FStar_Syntax_Syntax.ds = uu___4; + FStar_Syntax_Syntax.injective_type_params + = injective_type_params;_}; FStar_Syntax_Syntax.sigrng = uu___5; FStar_Syntax_Syntax.sigquals = tname_quals; FStar_Syntax_Syntax.sigmeta = uu___6; @@ -7449,7 +7464,10 @@ let rec (desugar_tycon : FStar_Syntax_Syntax.num_ty_params = ntps; FStar_Syntax_Syntax.mutuals1 - = mutuals1 + = mutuals1; + FStar_Syntax_Syntax.injective_type_params1 + = + injective_type_params } in FStar_Syntax_Syntax.Sig_datacon uu___17 in @@ -7551,7 +7569,10 @@ let rec (desugar_tycon : FStar_Syntax_Syntax.mutuals = mutuals1; FStar_Syntax_Syntax.ds - = constrNames + = constrNames; + FStar_Syntax_Syntax.injective_type_params + = + injective_type_params }); FStar_Syntax_Syntax.sigrng = uu___15; @@ -7620,16 +7641,18 @@ let rec (desugar_tycon : = uu___6; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___7; - FStar_Syntax_Syntax.ds = constrs;_} + FStar_Syntax_Syntax.ds = constrs; + FStar_Syntax_Syntax.injective_type_params + = uu___8;_} -> let quals1 = se.FStar_Syntax_Syntax.sigquals in - let uu___8 = + let uu___9 = FStar_Compiler_List.filter (fun data_lid -> let data_quals = let data_se = - let uu___9 = + let uu___10 = FStar_Compiler_List.find (fun se1 -> match se1.FStar_Syntax_Syntax.sigel @@ -7639,35 +7662,37 @@ let rec (desugar_tycon : FStar_Syntax_Syntax.lid1 = name; FStar_Syntax_Syntax.us1 - = uu___10; - FStar_Syntax_Syntax.t1 = uu___11; - FStar_Syntax_Syntax.ty_lid + FStar_Syntax_Syntax.t1 = uu___12; - FStar_Syntax_Syntax.num_ty_params + FStar_Syntax_Syntax.ty_lid = uu___13; + FStar_Syntax_Syntax.num_ty_params + = uu___14; FStar_Syntax_Syntax.mutuals1 - = uu___14;_} + = uu___15; + FStar_Syntax_Syntax.injective_type_params1 + = uu___16;_} -> FStar_Ident.lid_equals name data_lid - | uu___10 -> false) + | uu___11 -> false) sigelts in FStar_Compiler_Util.must - uu___9 in + uu___10 in data_se.FStar_Syntax_Syntax.sigquals in - let uu___9 = + let uu___10 = FStar_Compiler_List.existsb - (fun uu___10 -> - match uu___10 with + (fun uu___11 -> + match uu___11 with | FStar_Syntax_Syntax.RecordConstructor - uu___11 -> true - | uu___11 -> false) + uu___12 -> true + | uu___12 -> false) data_quals in - Prims.op_Negation uu___9) + Prims.op_Negation uu___10) constrs in mk_data_discriminators quals1 env3 - uu___8 + uu___9 se.FStar_Syntax_Syntax.sigattrs | uu___5 -> []) sigelts in let ops = @@ -9111,12 +9136,14 @@ and (desugar_decl_core : FStar_Syntax_Syntax.num_ty_params = uu___6; FStar_Syntax_Syntax.mutuals1 = - uu___7;_} + uu___7; + FStar_Syntax_Syntax.injective_type_params1 + = uu___8;_} -> - let uu___8 = + let uu___9 = FStar_Syntax_Util.arrow_formals t in - (match uu___8 with - | (formals1, uu___9) -> + (match uu___9 with + | (formals1, uu___10) -> FStar_Pervasives_Native.Some formals1) | uu___3 -> FStar_Pervasives_Native.None) @@ -9136,7 +9163,8 @@ and (desugar_decl_core : FStar_Syntax_Syntax.num_uniform_params = uu___4; FStar_Syntax_Syntax.t = ty; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_} + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_} -> let formals1 = match formals with @@ -9147,44 +9175,44 @@ and (desugar_decl_core : let i = FStar_Ident.ident_of_lid meth in FStar_Compiler_Util.for_some (fun formal -> - let uu___7 = + let uu___8 = FStar_Ident.ident_equals i (formal.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.ppname in - if uu___7 + if uu___8 then FStar_Compiler_Util.for_some (fun attr -> - let uu___8 = - let uu___9 = + let uu___9 = + let uu___10 = FStar_Syntax_Subst.compress attr in - uu___9.FStar_Syntax_Syntax.n in - match uu___8 with + uu___10.FStar_Syntax_Syntax.n in + match uu___9 with | FStar_Syntax_Syntax.Tm_fvar fv -> FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.no_method_lid - | uu___9 -> false) + | uu___10 -> false) formal.FStar_Syntax_Syntax.binder_attrs else false) formals1 in let meths1 = FStar_Compiler_List.filter (fun x -> - let uu___7 = has_no_method_attr x in - Prims.op_Negation uu___7) meths in + let uu___8 = has_no_method_attr x in + Prims.op_Negation uu___8) meths in let is_typed = false in - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = mkclass lid in + let uu___8 = + let uu___9 = + let uu___10 = + let uu___11 = mkclass lid in { FStar_Syntax_Syntax.is_typed = is_typed; FStar_Syntax_Syntax.lids2 = meths1; - FStar_Syntax_Syntax.tac = uu___10 + FStar_Syntax_Syntax.tac = uu___11 } in - FStar_Syntax_Syntax.Sig_splice uu___9 in - let uu___9 = + FStar_Syntax_Syntax.Sig_splice uu___10 in + let uu___10 = FStar_Syntax_DsEnv.opens_and_abbrevs env1 in { - FStar_Syntax_Syntax.sigel = uu___8; + FStar_Syntax_Syntax.sigel = uu___9; FStar_Syntax_Syntax.sigrng = (d.FStar_Parser_AST.drange); FStar_Syntax_Syntax.sigquals = []; @@ -9192,11 +9220,11 @@ and (desugar_decl_core : FStar_Syntax_Syntax.default_sigmeta; FStar_Syntax_Syntax.sigattrs = []; FStar_Syntax_Syntax.sigopens_and_abbrevs = - uu___9; + uu___10; FStar_Syntax_Syntax.sigopts = FStar_Pervasives_Native.None } in - [uu___7] + [uu___8] | uu___2 -> [] in let uu___2 = if typeclass @@ -9699,7 +9727,8 @@ and (desugar_decl_core : FStar_Parser_Const.exn_lid; FStar_Syntax_Syntax.num_ty_params = Prims.int_zero; FStar_Syntax_Syntax.mutuals1 = - [FStar_Parser_Const.exn_lid] + [FStar_Parser_Const.exn_lid]; + FStar_Syntax_Syntax.injective_type_params1 = false }); FStar_Syntax_Syntax.sigrng = (d.FStar_Parser_AST.drange); FStar_Syntax_Syntax.sigquals = qual; diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Common.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Common.ml index 5e803c000c9..3f6c69c7071 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Common.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Common.ml @@ -920,893 +920,6 @@ let (lcomp_of_comp_guard : FStar_Syntax_Syntax.comp -> guard_t -> lcomp) = (fun uu___1 -> (c0, g)) let (lcomp_of_comp : FStar_Syntax_Syntax.comp -> lcomp) = fun c0 -> lcomp_of_comp_guard c0 trivial_guard -let (simplify : - Prims.bool -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term) = - fun debug -> - fun tm -> - let w t = - { - FStar_Syntax_Syntax.n = (t.FStar_Syntax_Syntax.n); - FStar_Syntax_Syntax.pos = (tm.FStar_Syntax_Syntax.pos); - FStar_Syntax_Syntax.vars = (t.FStar_Syntax_Syntax.vars); - FStar_Syntax_Syntax.hash_code = (t.FStar_Syntax_Syntax.hash_code) - } in - let simp_t t = - let uu___ = - let uu___1 = FStar_Syntax_Util.unmeta t in - uu___1.FStar_Syntax_Syntax.n in - match uu___ with - | FStar_Syntax_Syntax.Tm_fvar fv when - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.true_lid -> - FStar_Pervasives_Native.Some true - | FStar_Syntax_Syntax.Tm_fvar fv when - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.false_lid -> - FStar_Pervasives_Native.Some false - | uu___1 -> FStar_Pervasives_Native.None in - let rec args_are_binders args bs = - match (args, bs) with - | ((t, uu___)::args1, b::bs1) -> - let uu___1 = - let uu___2 = FStar_Syntax_Subst.compress t in - uu___2.FStar_Syntax_Syntax.n in - (match uu___1 with - | FStar_Syntax_Syntax.Tm_name bv' -> - (FStar_Syntax_Syntax.bv_eq b.FStar_Syntax_Syntax.binder_bv - bv') - && (args_are_binders args1 bs1) - | uu___2 -> false) - | ([], []) -> true - | (uu___, uu___1) -> false in - let is_applied bs t = - if debug - then - (let uu___1 = FStar_Syntax_Print.term_to_string t in - let uu___2 = FStar_Syntax_Print.tag_of_term t in - FStar_Compiler_Util.print2 "WPE> is_applied %s -- %s\n" uu___1 - uu___2) - else (); - (let uu___1 = FStar_Syntax_Util.head_and_args_full t in - match uu___1 with - | (hd, args) -> - let uu___2 = - let uu___3 = FStar_Syntax_Subst.compress hd in - uu___3.FStar_Syntax_Syntax.n in - (match uu___2 with - | FStar_Syntax_Syntax.Tm_name bv when args_are_binders args bs - -> - (if debug - then - (let uu___4 = FStar_Syntax_Print.term_to_string t in - let uu___5 = FStar_Syntax_Print.bv_to_string bv in - let uu___6 = FStar_Syntax_Print.term_to_string hd in - FStar_Compiler_Util.print3 - "WPE> got it\n>>>>top = %s\n>>>>b = %s\n>>>>hd = %s\n" - uu___4 uu___5 uu___6) - else (); - FStar_Pervasives_Native.Some bv) - | uu___3 -> FStar_Pervasives_Native.None)) in - let is_applied_maybe_squashed bs t = - if debug - then - (let uu___1 = FStar_Syntax_Print.term_to_string t in - let uu___2 = FStar_Syntax_Print.tag_of_term t in - FStar_Compiler_Util.print2 - "WPE> is_applied_maybe_squashed %s -- %s\n" uu___1 uu___2) - else (); - (let uu___1 = FStar_Syntax_Util.is_squash t in - match uu___1 with - | FStar_Pervasives_Native.Some (uu___2, t') -> is_applied bs t' - | uu___2 -> - let uu___3 = FStar_Syntax_Util.is_auto_squash t in - (match uu___3 with - | FStar_Pervasives_Native.Some (uu___4, t') -> is_applied bs t' - | uu___4 -> is_applied bs t)) in - let is_const_match phi = - let uu___ = - let uu___1 = FStar_Syntax_Subst.compress phi in - uu___1.FStar_Syntax_Syntax.n in - match uu___ with - | FStar_Syntax_Syntax.Tm_match - { FStar_Syntax_Syntax.scrutinee = uu___1; - FStar_Syntax_Syntax.ret_opt = uu___2; - FStar_Syntax_Syntax.brs = br::brs; - FStar_Syntax_Syntax.rc_opt1 = uu___3;_} - -> - let uu___4 = br in - (match uu___4 with - | (uu___5, uu___6, e) -> - let r = - let uu___7 = simp_t e in - match uu___7 with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some b -> - let uu___8 = - FStar_Compiler_List.for_all - (fun uu___9 -> - match uu___9 with - | (uu___10, uu___11, e') -> - let uu___12 = simp_t e' in - uu___12 = (FStar_Pervasives_Native.Some b)) - brs in - if uu___8 - then FStar_Pervasives_Native.Some b - else FStar_Pervasives_Native.None in - r) - | uu___1 -> FStar_Pervasives_Native.None in - let maybe_auto_squash t = - let uu___ = FStar_Syntax_Util.is_sub_singleton t in - if uu___ - then t - else FStar_Syntax_Util.mk_auto_squash FStar_Syntax_Syntax.U_zero t in - let squashed_head_un_auto_squash_args t = - let maybe_un_auto_squash_arg uu___ = - match uu___ with - | (t1, q) -> - let uu___1 = FStar_Syntax_Util.is_auto_squash t1 in - (match uu___1 with - | FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.U_zero, t2) -> (t2, q) - | uu___2 -> (t1, q)) in - let uu___ = FStar_Syntax_Util.head_and_args t in - match uu___ with - | (head, args) -> - let args1 = FStar_Compiler_List.map maybe_un_auto_squash_arg args in - FStar_Syntax_Syntax.mk_Tm_app head args1 - t.FStar_Syntax_Syntax.pos in - let rec clearly_inhabited ty = - let uu___ = - let uu___1 = FStar_Syntax_Util.unmeta ty in - uu___1.FStar_Syntax_Syntax.n in - match uu___ with - | FStar_Syntax_Syntax.Tm_uinst (t, uu___1) -> clearly_inhabited t - | FStar_Syntax_Syntax.Tm_arrow - { FStar_Syntax_Syntax.bs1 = uu___1; - FStar_Syntax_Syntax.comp = c;_} - -> clearly_inhabited (FStar_Syntax_Util.comp_result c) - | FStar_Syntax_Syntax.Tm_fvar fv -> - let l = FStar_Syntax_Syntax.lid_of_fv fv in - (((FStar_Ident.lid_equals l FStar_Parser_Const.int_lid) || - (FStar_Ident.lid_equals l FStar_Parser_Const.bool_lid)) - || (FStar_Ident.lid_equals l FStar_Parser_Const.string_lid)) - || (FStar_Ident.lid_equals l FStar_Parser_Const.exn_lid) - | uu___1 -> false in - let simplify1 arg = - let uu___ = simp_t (FStar_Pervasives_Native.fst arg) in (uu___, arg) in - let uu___ = - let uu___1 = FStar_Syntax_Subst.compress tm in - uu___1.FStar_Syntax_Syntax.n in - match uu___ with - | FStar_Syntax_Syntax.Tm_app - { - FStar_Syntax_Syntax.hd = - { - FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_uinst - ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; - FStar_Syntax_Syntax.pos = uu___1; - FStar_Syntax_Syntax.vars = uu___2; - FStar_Syntax_Syntax.hash_code = uu___3;_}, - uu___4); - FStar_Syntax_Syntax.pos = uu___5; - FStar_Syntax_Syntax.vars = uu___6; - FStar_Syntax_Syntax.hash_code = uu___7;_}; - FStar_Syntax_Syntax.args = args;_} - -> - let uu___8 = - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.and_lid in - if uu___8 - then - let uu___9 = FStar_Compiler_List.map simplify1 args in - (match uu___9 with - | (FStar_Pervasives_Native.Some (true), uu___10)::(uu___11, - (arg, - uu___12))::[] - -> maybe_auto_squash arg - | (uu___10, (arg, uu___11))::(FStar_Pervasives_Native.Some - (true), uu___12)::[] - -> maybe_auto_squash arg - | (FStar_Pervasives_Native.Some (false), uu___10)::uu___11::[] - -> w FStar_Syntax_Util.t_false - | uu___10::(FStar_Pervasives_Native.Some (false), uu___11)::[] - -> w FStar_Syntax_Util.t_false - | uu___10 -> squashed_head_un_auto_squash_args tm) - else - (let uu___10 = - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.or_lid in - if uu___10 - then - let uu___11 = FStar_Compiler_List.map simplify1 args in - match uu___11 with - | (FStar_Pervasives_Native.Some (true), uu___12)::uu___13::[] - -> w FStar_Syntax_Util.t_true - | uu___12::(FStar_Pervasives_Native.Some (true), uu___13)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false), uu___12)::(uu___13, - (arg, - uu___14))::[] - -> maybe_auto_squash arg - | (uu___12, (arg, uu___13))::(FStar_Pervasives_Native.Some - (false), uu___14)::[] - -> maybe_auto_squash arg - | uu___12 -> squashed_head_un_auto_squash_args tm - else - (let uu___12 = - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.imp_lid in - if uu___12 - then - let uu___13 = FStar_Compiler_List.map simplify1 args in - match uu___13 with - | uu___14::(FStar_Pervasives_Native.Some (true), uu___15)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false), uu___14)::uu___15::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (true), uu___14)::(uu___15, - (arg, - uu___16))::[] - -> maybe_auto_squash arg - | (uu___14, (p, uu___15))::(uu___16, (q, uu___17))::[] -> - let uu___18 = FStar_Syntax_Util.term_eq p q in - (if uu___18 - then w FStar_Syntax_Util.t_true - else squashed_head_un_auto_squash_args tm) - | uu___14 -> squashed_head_un_auto_squash_args tm - else - (let uu___14 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.iff_lid in - if uu___14 - then - let uu___15 = FStar_Compiler_List.map simplify1 args in - match uu___15 with - | (FStar_Pervasives_Native.Some (true), uu___16):: - (FStar_Pervasives_Native.Some (true), uu___17)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false), uu___16):: - (FStar_Pervasives_Native.Some (false), uu___17)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (true), uu___16):: - (FStar_Pervasives_Native.Some (false), uu___17)::[] - -> w FStar_Syntax_Util.t_false - | (FStar_Pervasives_Native.Some (false), uu___16):: - (FStar_Pervasives_Native.Some (true), uu___17)::[] - -> w FStar_Syntax_Util.t_false - | (uu___16, (arg, uu___17))::(FStar_Pervasives_Native.Some - (true), uu___18)::[] - -> maybe_auto_squash arg - | (FStar_Pervasives_Native.Some (true), uu___16):: - (uu___17, (arg, uu___18))::[] -> - maybe_auto_squash arg - | (uu___16, (arg, uu___17))::(FStar_Pervasives_Native.Some - (false), uu___18)::[] - -> - let uu___19 = FStar_Syntax_Util.mk_neg arg in - maybe_auto_squash uu___19 - | (FStar_Pervasives_Native.Some (false), uu___16):: - (uu___17, (arg, uu___18))::[] -> - let uu___19 = FStar_Syntax_Util.mk_neg arg in - maybe_auto_squash uu___19 - | (uu___16, (p, uu___17))::(uu___18, (q, uu___19))::[] - -> - let uu___20 = FStar_Syntax_Util.term_eq p q in - (if uu___20 - then w FStar_Syntax_Util.t_true - else squashed_head_un_auto_squash_args tm) - | uu___16 -> squashed_head_un_auto_squash_args tm - else - (let uu___16 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.not_lid in - if uu___16 - then - let uu___17 = FStar_Compiler_List.map simplify1 args in - match uu___17 with - | (FStar_Pervasives_Native.Some (true), uu___18)::[] - -> w FStar_Syntax_Util.t_false - | (FStar_Pervasives_Native.Some (false), uu___18)::[] - -> w FStar_Syntax_Util.t_true - | uu___18 -> squashed_head_un_auto_squash_args tm - else - (let uu___18 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.forall_lid in - if uu___18 - then - match args with - | (t, uu___19)::[] -> - let uu___20 = - let uu___21 = FStar_Syntax_Subst.compress t in - uu___21.FStar_Syntax_Syntax.n in - (match uu___20 with - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = uu___21::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___22;_} - -> - let uu___23 = simp_t body in - (match uu___23 with - | FStar_Pervasives_Native.Some (true) -> - w FStar_Syntax_Util.t_true - | uu___24 -> tm) - | uu___21 -> tm) - | (ty, FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.aqual_implicit = true; - FStar_Syntax_Syntax.aqual_attributes = - uu___19;_})::(t, uu___20)::[] - -> - let uu___21 = - let uu___22 = FStar_Syntax_Subst.compress t in - uu___22.FStar_Syntax_Syntax.n in - (match uu___21 with - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = uu___22::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___23;_} - -> - let uu___24 = simp_t body in - (match uu___24 with - | FStar_Pervasives_Native.Some (true) -> - w FStar_Syntax_Util.t_true - | FStar_Pervasives_Native.Some (false) - when clearly_inhabited ty -> - w FStar_Syntax_Util.t_false - | uu___25 -> tm) - | uu___22 -> tm) - | uu___19 -> tm - else - (let uu___20 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.exists_lid in - if uu___20 - then - match args with - | (t, uu___21)::[] -> - let uu___22 = - let uu___23 = - FStar_Syntax_Subst.compress t in - uu___23.FStar_Syntax_Syntax.n in - (match uu___22 with - | FStar_Syntax_Syntax.Tm_abs - { - FStar_Syntax_Syntax.bs = uu___23::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___24;_} - -> - let uu___25 = simp_t body in - (match uu___25 with - | FStar_Pervasives_Native.Some - (false) -> - w FStar_Syntax_Util.t_false - | uu___26 -> tm) - | uu___23 -> tm) - | (ty, FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.aqual_implicit = true; - FStar_Syntax_Syntax.aqual_attributes = - uu___21;_})::(t, uu___22)::[] - -> - let uu___23 = - let uu___24 = - FStar_Syntax_Subst.compress t in - uu___24.FStar_Syntax_Syntax.n in - (match uu___23 with - | FStar_Syntax_Syntax.Tm_abs - { - FStar_Syntax_Syntax.bs = uu___24::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___25;_} - -> - let uu___26 = simp_t body in - (match uu___26 with - | FStar_Pervasives_Native.Some - (false) -> - w FStar_Syntax_Util.t_false - | FStar_Pervasives_Native.Some (true) - when clearly_inhabited ty -> - w FStar_Syntax_Util.t_true - | uu___27 -> tm) - | uu___24 -> tm) - | uu___21 -> tm - else - (let uu___22 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.b2t_lid in - if uu___22 - then - match args with - | ({ - FStar_Syntax_Syntax.n = - FStar_Syntax_Syntax.Tm_constant - (FStar_Const.Const_bool (true)); - FStar_Syntax_Syntax.pos = uu___23; - FStar_Syntax_Syntax.vars = uu___24; - FStar_Syntax_Syntax.hash_code = uu___25;_}, - uu___26)::[] -> - w FStar_Syntax_Util.t_true - | ({ - FStar_Syntax_Syntax.n = - FStar_Syntax_Syntax.Tm_constant - (FStar_Const.Const_bool (false)); - FStar_Syntax_Syntax.pos = uu___23; - FStar_Syntax_Syntax.vars = uu___24; - FStar_Syntax_Syntax.hash_code = uu___25;_}, - uu___26)::[] -> - w FStar_Syntax_Util.t_false - | uu___23 -> tm - else - (let uu___24 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.haseq_lid in - if uu___24 - then - let t_has_eq_for_sure t = - let haseq_lids = - [FStar_Parser_Const.int_lid; - FStar_Parser_Const.bool_lid; - FStar_Parser_Const.unit_lid; - FStar_Parser_Const.string_lid] in - let uu___25 = - let uu___26 = - FStar_Syntax_Subst.compress t in - uu___26.FStar_Syntax_Syntax.n in - match uu___25 with - | FStar_Syntax_Syntax.Tm_fvar fv1 when - FStar_Compiler_List.existsb - (fun l -> - FStar_Syntax_Syntax.fv_eq_lid - fv1 l) haseq_lids - -> true - | uu___26 -> false in - (if - (FStar_Compiler_List.length args) = - Prims.int_one - then - let t = - let uu___25 = - FStar_Compiler_List.hd args in - FStar_Pervasives_Native.fst uu___25 in - let uu___25 = t_has_eq_for_sure t in - (if uu___25 - then w FStar_Syntax_Util.t_true - else - (let uu___27 = - let uu___28 = - FStar_Syntax_Subst.compress t in - uu___28.FStar_Syntax_Syntax.n in - match uu___27 with - | FStar_Syntax_Syntax.Tm_refine - uu___28 -> - let t1 = - FStar_Syntax_Util.unrefine t in - let uu___29 = - t_has_eq_for_sure t1 in - if uu___29 - then - w FStar_Syntax_Util.t_true - else - (let haseq_tm = - let uu___31 = - let uu___32 = - FStar_Syntax_Subst.compress - tm in - uu___32.FStar_Syntax_Syntax.n in - match uu___31 with - | FStar_Syntax_Syntax.Tm_app - { - FStar_Syntax_Syntax.hd - = hd; - FStar_Syntax_Syntax.args - = uu___32;_} - -> hd - | uu___32 -> - FStar_Compiler_Effect.failwith - "Impossible! We have already checked that this is a Tm_app" in - let uu___31 = - let uu___32 = - FStar_Syntax_Syntax.as_arg - t1 in - [uu___32] in - FStar_Syntax_Util.mk_app - haseq_tm uu___31) - | uu___28 -> tm)) - else tm) - else - (let uu___26 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.eq2_lid in - if uu___26 - then - match args with - | (_typ, uu___27)::(a1, uu___28):: - (a2, uu___29)::[] -> - let uu___30 = - FStar_Syntax_Util.eq_tm a1 a2 in - (match uu___30 with - | FStar_Syntax_Util.Equal -> - w FStar_Syntax_Util.t_true - | FStar_Syntax_Util.NotEqual -> - w FStar_Syntax_Util.t_false - | uu___31 -> tm) - | uu___27 -> tm - else - (let uu___28 = - FStar_Syntax_Util.is_auto_squash tm in - match uu___28 with - | FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.U_zero, t) - when - FStar_Syntax_Util.is_sub_singleton - t - -> t - | uu___29 -> tm)))))))))) - | FStar_Syntax_Syntax.Tm_app - { - FStar_Syntax_Syntax.hd = - { FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; - FStar_Syntax_Syntax.pos = uu___1; - FStar_Syntax_Syntax.vars = uu___2; - FStar_Syntax_Syntax.hash_code = uu___3;_}; - FStar_Syntax_Syntax.args = args;_} - -> - let uu___4 = - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.and_lid in - if uu___4 - then - let uu___5 = FStar_Compiler_List.map simplify1 args in - (match uu___5 with - | (FStar_Pervasives_Native.Some (true), uu___6)::(uu___7, - (arg, uu___8))::[] - -> maybe_auto_squash arg - | (uu___6, (arg, uu___7))::(FStar_Pervasives_Native.Some (true), - uu___8)::[] - -> maybe_auto_squash arg - | (FStar_Pervasives_Native.Some (false), uu___6)::uu___7::[] -> - w FStar_Syntax_Util.t_false - | uu___6::(FStar_Pervasives_Native.Some (false), uu___7)::[] -> - w FStar_Syntax_Util.t_false - | uu___6 -> squashed_head_un_auto_squash_args tm) - else - (let uu___6 = - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.or_lid in - if uu___6 - then - let uu___7 = FStar_Compiler_List.map simplify1 args in - match uu___7 with - | (FStar_Pervasives_Native.Some (true), uu___8)::uu___9::[] -> - w FStar_Syntax_Util.t_true - | uu___8::(FStar_Pervasives_Native.Some (true), uu___9)::[] -> - w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false), uu___8)::(uu___9, - (arg, - uu___10))::[] - -> maybe_auto_squash arg - | (uu___8, (arg, uu___9))::(FStar_Pervasives_Native.Some - (false), uu___10)::[] - -> maybe_auto_squash arg - | uu___8 -> squashed_head_un_auto_squash_args tm - else - (let uu___8 = - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.imp_lid in - if uu___8 - then - let uu___9 = FStar_Compiler_List.map simplify1 args in - match uu___9 with - | uu___10::(FStar_Pervasives_Native.Some (true), uu___11)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false), uu___10)::uu___11::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (true), uu___10)::(uu___11, - (arg, - uu___12))::[] - -> maybe_auto_squash arg - | (uu___10, (p, uu___11))::(uu___12, (q, uu___13))::[] -> - let uu___14 = FStar_Syntax_Util.term_eq p q in - (if uu___14 - then w FStar_Syntax_Util.t_true - else squashed_head_un_auto_squash_args tm) - | uu___10 -> squashed_head_un_auto_squash_args tm - else - (let uu___10 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.iff_lid in - if uu___10 - then - let uu___11 = FStar_Compiler_List.map simplify1 args in - match uu___11 with - | (FStar_Pervasives_Native.Some (true), uu___12):: - (FStar_Pervasives_Native.Some (true), uu___13)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false), uu___12):: - (FStar_Pervasives_Native.Some (false), uu___13)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (true), uu___12):: - (FStar_Pervasives_Native.Some (false), uu___13)::[] - -> w FStar_Syntax_Util.t_false - | (FStar_Pervasives_Native.Some (false), uu___12):: - (FStar_Pervasives_Native.Some (true), uu___13)::[] - -> w FStar_Syntax_Util.t_false - | (uu___12, (arg, uu___13))::(FStar_Pervasives_Native.Some - (true), uu___14)::[] - -> maybe_auto_squash arg - | (FStar_Pervasives_Native.Some (true), uu___12):: - (uu___13, (arg, uu___14))::[] -> - maybe_auto_squash arg - | (uu___12, (arg, uu___13))::(FStar_Pervasives_Native.Some - (false), uu___14)::[] - -> - let uu___15 = FStar_Syntax_Util.mk_neg arg in - maybe_auto_squash uu___15 - | (FStar_Pervasives_Native.Some (false), uu___12):: - (uu___13, (arg, uu___14))::[] -> - let uu___15 = FStar_Syntax_Util.mk_neg arg in - maybe_auto_squash uu___15 - | (uu___12, (p, uu___13))::(uu___14, (q, uu___15))::[] - -> - let uu___16 = FStar_Syntax_Util.term_eq p q in - (if uu___16 - then w FStar_Syntax_Util.t_true - else squashed_head_un_auto_squash_args tm) - | uu___12 -> squashed_head_un_auto_squash_args tm - else - (let uu___12 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.not_lid in - if uu___12 - then - let uu___13 = FStar_Compiler_List.map simplify1 args in - match uu___13 with - | (FStar_Pervasives_Native.Some (true), uu___14)::[] - -> w FStar_Syntax_Util.t_false - | (FStar_Pervasives_Native.Some (false), uu___14)::[] - -> w FStar_Syntax_Util.t_true - | uu___14 -> squashed_head_un_auto_squash_args tm - else - (let uu___14 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.forall_lid in - if uu___14 - then - match args with - | (t, uu___15)::[] -> - let uu___16 = - let uu___17 = FStar_Syntax_Subst.compress t in - uu___17.FStar_Syntax_Syntax.n in - (match uu___16 with - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = uu___17::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___18;_} - -> - let uu___19 = simp_t body in - (match uu___19 with - | FStar_Pervasives_Native.Some (true) -> - w FStar_Syntax_Util.t_true - | uu___20 -> tm) - | uu___17 -> tm) - | (ty, FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.aqual_implicit = true; - FStar_Syntax_Syntax.aqual_attributes = - uu___15;_})::(t, uu___16)::[] - -> - let uu___17 = - let uu___18 = FStar_Syntax_Subst.compress t in - uu___18.FStar_Syntax_Syntax.n in - (match uu___17 with - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = uu___18::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___19;_} - -> - let uu___20 = simp_t body in - (match uu___20 with - | FStar_Pervasives_Native.Some (true) -> - w FStar_Syntax_Util.t_true - | FStar_Pervasives_Native.Some (false) - when clearly_inhabited ty -> - w FStar_Syntax_Util.t_false - | uu___21 -> tm) - | uu___18 -> tm) - | uu___15 -> tm - else - (let uu___16 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.exists_lid in - if uu___16 - then - match args with - | (t, uu___17)::[] -> - let uu___18 = - let uu___19 = - FStar_Syntax_Subst.compress t in - uu___19.FStar_Syntax_Syntax.n in - (match uu___18 with - | FStar_Syntax_Syntax.Tm_abs - { - FStar_Syntax_Syntax.bs = uu___19::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___20;_} - -> - let uu___21 = simp_t body in - (match uu___21 with - | FStar_Pervasives_Native.Some - (false) -> - w FStar_Syntax_Util.t_false - | uu___22 -> tm) - | uu___19 -> tm) - | (ty, FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.aqual_implicit = true; - FStar_Syntax_Syntax.aqual_attributes = - uu___17;_})::(t, uu___18)::[] - -> - let uu___19 = - let uu___20 = - FStar_Syntax_Subst.compress t in - uu___20.FStar_Syntax_Syntax.n in - (match uu___19 with - | FStar_Syntax_Syntax.Tm_abs - { - FStar_Syntax_Syntax.bs = uu___20::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___21;_} - -> - let uu___22 = simp_t body in - (match uu___22 with - | FStar_Pervasives_Native.Some - (false) -> - w FStar_Syntax_Util.t_false - | FStar_Pervasives_Native.Some (true) - when clearly_inhabited ty -> - w FStar_Syntax_Util.t_true - | uu___23 -> tm) - | uu___20 -> tm) - | uu___17 -> tm - else - (let uu___18 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.b2t_lid in - if uu___18 - then - match args with - | ({ - FStar_Syntax_Syntax.n = - FStar_Syntax_Syntax.Tm_constant - (FStar_Const.Const_bool (true)); - FStar_Syntax_Syntax.pos = uu___19; - FStar_Syntax_Syntax.vars = uu___20; - FStar_Syntax_Syntax.hash_code = uu___21;_}, - uu___22)::[] -> - w FStar_Syntax_Util.t_true - | ({ - FStar_Syntax_Syntax.n = - FStar_Syntax_Syntax.Tm_constant - (FStar_Const.Const_bool (false)); - FStar_Syntax_Syntax.pos = uu___19; - FStar_Syntax_Syntax.vars = uu___20; - FStar_Syntax_Syntax.hash_code = uu___21;_}, - uu___22)::[] -> - w FStar_Syntax_Util.t_false - | uu___19 -> tm - else - (let uu___20 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.haseq_lid in - if uu___20 - then - let t_has_eq_for_sure t = - let haseq_lids = - [FStar_Parser_Const.int_lid; - FStar_Parser_Const.bool_lid; - FStar_Parser_Const.unit_lid; - FStar_Parser_Const.string_lid] in - let uu___21 = - let uu___22 = - FStar_Syntax_Subst.compress t in - uu___22.FStar_Syntax_Syntax.n in - match uu___21 with - | FStar_Syntax_Syntax.Tm_fvar fv1 when - FStar_Compiler_List.existsb - (fun l -> - FStar_Syntax_Syntax.fv_eq_lid - fv1 l) haseq_lids - -> true - | uu___22 -> false in - (if - (FStar_Compiler_List.length args) = - Prims.int_one - then - let t = - let uu___21 = - FStar_Compiler_List.hd args in - FStar_Pervasives_Native.fst uu___21 in - let uu___21 = t_has_eq_for_sure t in - (if uu___21 - then w FStar_Syntax_Util.t_true - else - (let uu___23 = - let uu___24 = - FStar_Syntax_Subst.compress t in - uu___24.FStar_Syntax_Syntax.n in - match uu___23 with - | FStar_Syntax_Syntax.Tm_refine - uu___24 -> - let t1 = - FStar_Syntax_Util.unrefine t in - let uu___25 = - t_has_eq_for_sure t1 in - if uu___25 - then - w FStar_Syntax_Util.t_true - else - (let haseq_tm = - let uu___27 = - let uu___28 = - FStar_Syntax_Subst.compress - tm in - uu___28.FStar_Syntax_Syntax.n in - match uu___27 with - | FStar_Syntax_Syntax.Tm_app - { - FStar_Syntax_Syntax.hd - = hd; - FStar_Syntax_Syntax.args - = uu___28;_} - -> hd - | uu___28 -> - FStar_Compiler_Effect.failwith - "Impossible! We have already checked that this is a Tm_app" in - let uu___27 = - let uu___28 = - FStar_Syntax_Syntax.as_arg - t1 in - [uu___28] in - FStar_Syntax_Util.mk_app - haseq_tm uu___27) - | uu___24 -> tm)) - else tm) - else - (let uu___22 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.eq2_lid in - if uu___22 - then - match args with - | (_typ, uu___23)::(a1, uu___24):: - (a2, uu___25)::[] -> - let uu___26 = - FStar_Syntax_Util.eq_tm a1 a2 in - (match uu___26 with - | FStar_Syntax_Util.Equal -> - w FStar_Syntax_Util.t_true - | FStar_Syntax_Util.NotEqual -> - w FStar_Syntax_Util.t_false - | uu___27 -> tm) - | uu___23 -> tm - else - (let uu___24 = - FStar_Syntax_Util.is_auto_squash tm in - match uu___24 with - | FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.U_zero, t) - when - FStar_Syntax_Util.is_sub_singleton - t - -> t - | uu___25 -> tm)))))))))) - | FStar_Syntax_Syntax.Tm_refine - { FStar_Syntax_Syntax.b = bv; FStar_Syntax_Syntax.phi = t;_} -> - let uu___1 = simp_t t in - (match uu___1 with - | FStar_Pervasives_Native.Some (true) -> - bv.FStar_Syntax_Syntax.sort - | FStar_Pervasives_Native.Some (false) -> tm - | FStar_Pervasives_Native.None -> tm) - | FStar_Syntax_Syntax.Tm_match uu___1 -> - let uu___2 = is_const_match tm in - (match uu___2 with - | FStar_Pervasives_Native.Some (true) -> - w FStar_Syntax_Util.t_true - | FStar_Pervasives_Native.Some (false) -> - w FStar_Syntax_Util.t_false - | FStar_Pervasives_Native.None -> tm) - | uu___1 -> tm let (check_positivity_qual : Prims.bool -> FStar_Syntax_Syntax.positivity_qualifier FStar_Pervasives_Native.option diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml index ec893d12455..c4b9416044e 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml @@ -3579,8 +3579,9 @@ and (check_relation_comp : match uu___ with | (FStar_Pervasives_Native.None, uu___1) -> let uu___2 = - let uu___3 = FStar_Syntax_Util.eq_comp c0 c1 in - uu___3 = FStar_Syntax_Util.Equal in + let uu___3 = + FStar_TypeChecker_TermEqAndSimplify.eq_comp g.tcenv c0 c1 in + uu___3 = FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___2 then (fun uu___3 -> Success ((), FStar_Pervasives_Native.None)) else @@ -3642,8 +3643,9 @@ and (check_relation_comp : fail uu___10)))) | (uu___1, FStar_Pervasives_Native.None) -> let uu___2 = - let uu___3 = FStar_Syntax_Util.eq_comp c0 c1 in - uu___3 = FStar_Syntax_Util.Equal in + let uu___3 = + FStar_TypeChecker_TermEqAndSimplify.eq_comp g.tcenv c0 c1 in + uu___3 = FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___2 then (fun uu___3 -> Success ((), FStar_Pervasives_Native.None)) else diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml index 926fa890760..3cb3b06b329 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml @@ -3673,7 +3673,7 @@ and (trans_F_ : ((let uu___10 = let uu___11 = FStar_Syntax_Util.eq_aqual q q' in - uu___11 <> FStar_Syntax_Util.Equal in + Prims.op_Negation uu___11 in if uu___10 then let uu___11 = diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml index bd7a122b030..9f43b534223 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml @@ -54,7 +54,7 @@ let (uu___is_Imp : goal_type -> Prims.bool) = let (__proj__Imp__item___0 : goal_type -> FStar_Syntax_Syntax.ctx_uvar) = fun projectee -> match projectee with | Imp _0 -> _0 let (find_user_tac_for_uvar : - FStar_TypeChecker_Env.env -> + FStar_TypeChecker_Env.env_t -> FStar_Syntax_Syntax.ctx_uvar -> FStar_Syntax_Syntax.sigelt FStar_Pervasives_Native.option) = @@ -120,7 +120,8 @@ let (find_user_tac_for_uvar : let candidates = FStar_Compiler_List.filter (fun hook -> - FStar_Compiler_Util.for_some (FStar_Syntax_Util.attr_eq a) + FStar_Compiler_Util.for_some + (FStar_TypeChecker_TermEqAndSimplify.eq_tm_bool env a) hook.FStar_Syntax_Syntax.sigattrs) hooks in let candidates1 = FStar_Compiler_Util.remove_dups @@ -156,7 +157,9 @@ let (find_user_tac_for_uvar : when (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.override_resolve_implicits_handler_lid) - && (FStar_Syntax_Util.attr_eq a a') + && + (FStar_TypeChecker_TermEqAndSimplify.eq_tm_bool + env a a') -> let uu___5 = attr_list_elements overrides in (match uu___5 with @@ -174,7 +177,9 @@ let (find_user_tac_for_uvar : (a', uu___2)::(overrides, uu___3)::[]) when (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.override_resolve_implicits_handler_lid) - && (FStar_Syntax_Util.attr_eq a a') + && + (FStar_TypeChecker_TermEqAndSimplify.eq_tm_bool + env a a') -> let uu___4 = attr_list_elements overrides in (match uu___4 with diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml index c0f4329182e..7958787df72 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml @@ -3141,18 +3141,19 @@ let (try_lookup_lid_aux : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_}; - FStar_Syntax_Syntax.sigrng = uu___5; - FStar_Syntax_Syntax.sigquals = uu___6; - FStar_Syntax_Syntax.sigmeta = uu___7; - FStar_Syntax_Syntax.sigattrs = uu___8; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; - FStar_Syntax_Syntax.sigopts = uu___10;_}, + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_}; + FStar_Syntax_Syntax.sigrng = uu___6; + FStar_Syntax_Syntax.sigquals = uu___7; + FStar_Syntax_Syntax.sigmeta = uu___8; + FStar_Syntax_Syntax.sigattrs = uu___9; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___10; + FStar_Syntax_Syntax.sigopts = uu___11;_}, FStar_Pervasives_Native.None) -> - let uu___11 = - let uu___12 = inst_tscheme1 (uvs, t) in (uu___12, rng) in - FStar_Pervasives_Native.Some uu___11 + let uu___12 = + let uu___13 = inst_tscheme1 (uvs, t) in (uu___13, rng) in + FStar_Pervasives_Native.Some uu___12 | FStar_Pervasives.Inr ({ FStar_Syntax_Syntax.sigel = @@ -3196,32 +3197,33 @@ let (try_lookup_lid_aux : FStar_Syntax_Syntax.num_uniform_params = uu___1; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___2; - FStar_Syntax_Syntax.ds = uu___3;_}; - FStar_Syntax_Syntax.sigrng = uu___4; - FStar_Syntax_Syntax.sigquals = uu___5; - FStar_Syntax_Syntax.sigmeta = uu___6; - FStar_Syntax_Syntax.sigattrs = uu___7; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___8; - FStar_Syntax_Syntax.sigopts = uu___9;_}, + FStar_Syntax_Syntax.ds = uu___3; + FStar_Syntax_Syntax.injective_type_params = uu___4;_}; + FStar_Syntax_Syntax.sigrng = uu___5; + FStar_Syntax_Syntax.sigquals = uu___6; + FStar_Syntax_Syntax.sigmeta = uu___7; + FStar_Syntax_Syntax.sigattrs = uu___8; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; + FStar_Syntax_Syntax.sigopts = uu___10;_}, FStar_Pervasives_Native.None) -> (match tps with | [] -> - let uu___10 = - let uu___11 = inst_tscheme1 (uvs, k) in - (uu___11, rng) in - FStar_Pervasives_Native.Some uu___10 - | uu___10 -> let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = - let uu___15 = FStar_Syntax_Syntax.mk_Total k in - FStar_Syntax_Util.flat_arrow tps uu___15 in - (uvs, uu___14) in - inst_tscheme1 uu___13 in + let uu___12 = inst_tscheme1 (uvs, k) in (uu___12, rng) in - FStar_Pervasives_Native.Some uu___11) + FStar_Pervasives_Native.Some uu___11 + | uu___11 -> + let uu___12 = + let uu___13 = + let uu___14 = + let uu___15 = + let uu___16 = FStar_Syntax_Syntax.mk_Total k in + FStar_Syntax_Util.flat_arrow tps uu___16 in + (uvs, uu___15) in + inst_tscheme1 uu___14 in + (uu___13, rng) in + FStar_Pervasives_Native.Some uu___12) | FStar_Pervasives.Inr ({ FStar_Syntax_Syntax.sigel = @@ -3232,32 +3234,33 @@ let (try_lookup_lid_aux : FStar_Syntax_Syntax.num_uniform_params = uu___1; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___2; - FStar_Syntax_Syntax.ds = uu___3;_}; - FStar_Syntax_Syntax.sigrng = uu___4; - FStar_Syntax_Syntax.sigquals = uu___5; - FStar_Syntax_Syntax.sigmeta = uu___6; - FStar_Syntax_Syntax.sigattrs = uu___7; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___8; - FStar_Syntax_Syntax.sigopts = uu___9;_}, + FStar_Syntax_Syntax.ds = uu___3; + FStar_Syntax_Syntax.injective_type_params = uu___4;_}; + FStar_Syntax_Syntax.sigrng = uu___5; + FStar_Syntax_Syntax.sigquals = uu___6; + FStar_Syntax_Syntax.sigmeta = uu___7; + FStar_Syntax_Syntax.sigattrs = uu___8; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; + FStar_Syntax_Syntax.sigopts = uu___10;_}, FStar_Pervasives_Native.Some us) -> (match tps with | [] -> - let uu___10 = - let uu___11 = inst_tscheme_with (uvs, k) us in - (uu___11, rng) in - FStar_Pervasives_Native.Some uu___10 - | uu___10 -> let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = - let uu___15 = FStar_Syntax_Syntax.mk_Total k in - FStar_Syntax_Util.flat_arrow tps uu___15 in - (uvs, uu___14) in - inst_tscheme_with uu___13 us in + let uu___12 = inst_tscheme_with (uvs, k) us in (uu___12, rng) in - FStar_Pervasives_Native.Some uu___11) + FStar_Pervasives_Native.Some uu___11 + | uu___11 -> + let uu___12 = + let uu___13 = + let uu___14 = + let uu___15 = + let uu___16 = FStar_Syntax_Syntax.mk_Total k in + FStar_Syntax_Util.flat_arrow tps uu___16 in + (uvs, uu___15) in + inst_tscheme_with uu___14 us in + (uu___13, rng) in + FStar_Pervasives_Native.Some uu___12) | FStar_Pervasives.Inr se -> let uu___1 = match se with @@ -3481,18 +3484,19 @@ let (lookup_datacon : FStar_Syntax_Syntax.us1 = uvs; FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_}; - FStar_Syntax_Syntax.sigrng = uu___5; - FStar_Syntax_Syntax.sigquals = uu___6; - FStar_Syntax_Syntax.sigmeta = uu___7; - FStar_Syntax_Syntax.sigattrs = uu___8; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; - FStar_Syntax_Syntax.sigopts = uu___10;_}, + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_}; + FStar_Syntax_Syntax.sigrng = uu___6; + FStar_Syntax_Syntax.sigquals = uu___7; + FStar_Syntax_Syntax.sigmeta = uu___8; + FStar_Syntax_Syntax.sigattrs = uu___9; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___10; + FStar_Syntax_Syntax.sigopts = uu___11;_}, FStar_Pervasives_Native.None), - uu___11) + uu___12) -> - let uu___12 = FStar_Ident.range_of_lid lid in - inst_tscheme_with_range uu___12 (uvs, t) + let uu___13 = FStar_Ident.range_of_lid lid in + inst_tscheme_with_range uu___13 (uvs, t) | uu___1 -> let uu___2 = name_not_found lid in let uu___3 = FStar_Ident.range_of_lid lid in @@ -3516,18 +3520,19 @@ let (lookup_and_inst_datacon : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_}; - FStar_Syntax_Syntax.sigrng = uu___5; - FStar_Syntax_Syntax.sigquals = uu___6; - FStar_Syntax_Syntax.sigmeta = uu___7; - FStar_Syntax_Syntax.sigattrs = uu___8; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; - FStar_Syntax_Syntax.sigopts = uu___10;_}, + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_}; + FStar_Syntax_Syntax.sigrng = uu___6; + FStar_Syntax_Syntax.sigquals = uu___7; + FStar_Syntax_Syntax.sigmeta = uu___8; + FStar_Syntax_Syntax.sigattrs = uu___9; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___10; + FStar_Syntax_Syntax.sigopts = uu___11;_}, FStar_Pervasives_Native.None), - uu___11) + uu___12) -> - let uu___12 = inst_tscheme_with (uvs, t) us in - FStar_Pervasives_Native.snd uu___12 + let uu___13 = inst_tscheme_with (uvs, t) us in + FStar_Pervasives_Native.snd uu___13 | uu___1 -> let uu___2 = name_not_found lid in let uu___3 = FStar_Ident.range_of_lid lid in @@ -3550,7 +3555,34 @@ let (datacons_of_typ : FStar_Syntax_Syntax.num_uniform_params = uu___4; FStar_Syntax_Syntax.t = uu___5; FStar_Syntax_Syntax.mutuals = uu___6; - FStar_Syntax_Syntax.ds = dcs;_}; + FStar_Syntax_Syntax.ds = dcs; + FStar_Syntax_Syntax.injective_type_params = uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_}, + uu___14), + uu___15) + -> (true, dcs) + | uu___1 -> (false, []) +let (typ_of_datacon : env -> FStar_Ident.lident -> FStar_Ident.lident) = + fun env1 -> + fun lid -> + let uu___ = lookup_qname env1 lid in + match uu___ with + | FStar_Pervasives_Native.Some + (FStar_Pervasives.Inr + ({ + FStar_Syntax_Syntax.sigel = FStar_Syntax_Syntax.Sig_datacon + { FStar_Syntax_Syntax.lid1 = uu___1; + FStar_Syntax_Syntax.us1 = uu___2; + FStar_Syntax_Syntax.t1 = uu___3; + FStar_Syntax_Syntax.ty_lid = l; + FStar_Syntax_Syntax.num_ty_params = uu___4; + FStar_Syntax_Syntax.mutuals1 = uu___5; + FStar_Syntax_Syntax.injective_type_params1 = uu___6;_}; FStar_Syntax_Syntax.sigrng = uu___7; FStar_Syntax_Syntax.sigquals = uu___8; FStar_Syntax_Syntax.sigmeta = uu___9; @@ -3559,9 +3591,14 @@ let (datacons_of_typ : FStar_Syntax_Syntax.sigopts = uu___12;_}, uu___13), uu___14) - -> (true, dcs) - | uu___1 -> (false, []) -let (typ_of_datacon : env -> FStar_Ident.lident -> FStar_Ident.lident) = + -> l + | uu___1 -> + let uu___2 = + let uu___3 = FStar_Syntax_Print.lid_to_string lid in + FStar_Compiler_Util.format1 "Not a datacon: %s" uu___3 in + FStar_Compiler_Effect.failwith uu___2 +let (num_datacon_non_injective_ty_params : + env -> FStar_Ident.lident -> Prims.int FStar_Pervasives_Native.option) = fun env1 -> fun lid -> let uu___ = lookup_qname env1 lid in @@ -3573,9 +3610,11 @@ let (typ_of_datacon : env -> FStar_Ident.lident -> FStar_Ident.lident) = { FStar_Syntax_Syntax.lid1 = uu___1; FStar_Syntax_Syntax.us1 = uu___2; FStar_Syntax_Syntax.t1 = uu___3; - FStar_Syntax_Syntax.ty_lid = l; - FStar_Syntax_Syntax.num_ty_params = uu___4; - FStar_Syntax_Syntax.mutuals1 = uu___5;_}; + FStar_Syntax_Syntax.ty_lid = uu___4; + FStar_Syntax_Syntax.num_ty_params = num_ty_params; + FStar_Syntax_Syntax.mutuals1 = uu___5; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params;_}; FStar_Syntax_Syntax.sigrng = uu___6; FStar_Syntax_Syntax.sigquals = uu___7; FStar_Syntax_Syntax.sigmeta = uu___8; @@ -3584,12 +3623,11 @@ let (typ_of_datacon : env -> FStar_Ident.lident -> FStar_Ident.lident) = FStar_Syntax_Syntax.sigopts = uu___11;_}, uu___12), uu___13) - -> l - | uu___1 -> - let uu___2 = - let uu___3 = FStar_Syntax_Print.lid_to_string lid in - FStar_Compiler_Util.format1 "Not a datacon: %s" uu___3 in - FStar_Compiler_Effect.failwith uu___2 + -> + if injective_type_params + then FStar_Pervasives_Native.Some Prims.int_zero + else FStar_Pervasives_Native.Some num_ty_params + | uu___1 -> FStar_Pervasives_Native.None let (lookup_definition_qninfo_aux : Prims.bool -> delta_level Prims.list -> @@ -4427,15 +4465,16 @@ let (num_inductive_ty_params : FStar_Syntax_Syntax.num_uniform_params = uu___3; FStar_Syntax_Syntax.t = uu___4; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_}, - uu___13), - uu___14) + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_}, + uu___14), + uu___15) -> FStar_Pervasives_Native.Some (FStar_Compiler_List.length tps) | uu___1 -> FStar_Pervasives_Native.None let (num_inductive_uniform_ty_params : @@ -4455,27 +4494,28 @@ let (num_inductive_uniform_ty_params : FStar_Syntax_Syntax.num_uniform_params = num_uniform; FStar_Syntax_Syntax.t = uu___4; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_}, - uu___13), - uu___14) + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_}, + uu___14), + uu___15) -> (match num_uniform with | FStar_Pervasives_Native.None -> - let uu___15 = - let uu___16 = - let uu___17 = FStar_Ident.string_of_lid lid in + let uu___16 = + let uu___17 = + let uu___18 = FStar_Ident.string_of_lid lid in FStar_Compiler_Util.format1 "Internal error: Inductive %s is not decorated with its uniform type parameters" - uu___17 in - (FStar_Errors_Codes.Fatal_UnexpectedInductivetype, uu___16) in - let uu___16 = FStar_Ident.range_of_lid lid in - FStar_Errors.raise_error uu___15 uu___16 + uu___18 in + (FStar_Errors_Codes.Fatal_UnexpectedInductivetype, uu___17) in + let uu___17 = FStar_Ident.range_of_lid lid in + FStar_Errors.raise_error uu___16 uu___17 | FStar_Pervasives_Native.Some n -> FStar_Pervasives_Native.Some n) | uu___1 -> FStar_Pervasives_Native.None let (effect_decl_opt : diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml index 45c3aa2d80c..2714cff0163 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml @@ -1582,7 +1582,10 @@ let (reduce_equality : fun norm_cb -> fun cfg -> fun tm -> - reduce_primops norm_cb + let uu___ = + let uu___1 = + FStar_TypeChecker_Cfg.equality_ops + cfg.FStar_TypeChecker_Cfg.tcenv in { FStar_TypeChecker_Cfg.steps = { @@ -1652,8 +1655,7 @@ let (reduce_equality : FStar_TypeChecker_Cfg.debug = (cfg.FStar_TypeChecker_Cfg.debug); FStar_TypeChecker_Cfg.delta_level = (cfg.FStar_TypeChecker_Cfg.delta_level); - FStar_TypeChecker_Cfg.primitive_steps = - FStar_TypeChecker_Cfg.equality_ops; + FStar_TypeChecker_Cfg.primitive_steps = uu___1; FStar_TypeChecker_Cfg.strong = (cfg.FStar_TypeChecker_Cfg.strong); FStar_TypeChecker_Cfg.memoize_lazy = (cfg.FStar_TypeChecker_Cfg.memoize_lazy); @@ -1663,7 +1665,8 @@ let (reduce_equality : (cfg.FStar_TypeChecker_Cfg.reifying); FStar_TypeChecker_Cfg.compat_memo_ignore_cfg = (cfg.FStar_TypeChecker_Cfg.compat_memo_ignore_cfg) - } tm + } in + reduce_primops norm_cb uu___ tm type norm_request_t = | Norm_request_none | Norm_request_ready @@ -4970,7 +4973,8 @@ and (do_reify_monadic : (let maybe_range_arg = let uu___12 = FStar_Compiler_Util.for_some - (FStar_Syntax_Util.attr_eq + (FStar_TypeChecker_TermEqAndSimplify.eq_tm_bool + cfg.FStar_TypeChecker_Cfg.tcenv FStar_Syntax_Util.dm4f_bind_range_attr) ed.FStar_Syntax_Syntax.eff_attrs in if uu___12 @@ -6418,10 +6422,12 @@ and (maybe_simplify_aux : -> (t, false) | uu___32 -> let uu___33 = - norm_cb cfg in - reduce_equality - uu___33 cfg - env1 tm1)))))))))) + let uu___34 = + norm_cb cfg in + reduce_equality + uu___34 cfg + env1 in + uu___33 tm1)))))))))) | FStar_Syntax_Syntax.Tm_app { FStar_Syntax_Syntax.hd = @@ -6963,10 +6969,12 @@ and (maybe_simplify_aux : -> (t, false) | uu___28 -> let uu___29 = - norm_cb cfg in - reduce_equality - uu___29 cfg - env1 tm1)))))))))) + let uu___30 = + norm_cb cfg in + reduce_equality + uu___30 cfg + env1 in + uu___29 tm1)))))))))) | FStar_Syntax_Syntax.Tm_refine { FStar_Syntax_Syntax.b = bv; FStar_Syntax_Syntax.phi = t;_} @@ -8993,7 +9001,8 @@ let rec (elim_uvars : FStar_Syntax_Syntax.params = binders; FStar_Syntax_Syntax.num_uniform_params = num_uniform; FStar_Syntax_Syntax.t = typ; FStar_Syntax_Syntax.mutuals = lids; - FStar_Syntax_Syntax.ds = lids';_} + FStar_Syntax_Syntax.ds = lids'; + FStar_Syntax_Syntax.injective_type_params = injective_type_params;_} -> let uu___ = elim_uvars_aux_t env1 univ_names binders typ in (match uu___ with @@ -9008,7 +9017,9 @@ let rec (elim_uvars : FStar_Syntax_Syntax.num_uniform_params = num_uniform; FStar_Syntax_Syntax.t = typ1; FStar_Syntax_Syntax.mutuals = lids; - FStar_Syntax_Syntax.ds = lids' + FStar_Syntax_Syntax.ds = lids'; + FStar_Syntax_Syntax.injective_type_params = + injective_type_params }); FStar_Syntax_Syntax.sigrng = (s1.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = @@ -9050,7 +9061,9 @@ let rec (elim_uvars : FStar_Syntax_Syntax.t1 = typ; FStar_Syntax_Syntax.ty_lid = lident; FStar_Syntax_Syntax.num_ty_params = i; - FStar_Syntax_Syntax.mutuals1 = lids;_} + FStar_Syntax_Syntax.mutuals1 = lids; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params;_} -> let uu___ = elim_uvars_aux_t env1 univ_names [] typ in (match uu___ with @@ -9064,7 +9077,9 @@ let rec (elim_uvars : FStar_Syntax_Syntax.t1 = typ1; FStar_Syntax_Syntax.ty_lid = lident; FStar_Syntax_Syntax.num_ty_params = i; - FStar_Syntax_Syntax.mutuals1 = lids + FStar_Syntax_Syntax.mutuals1 = lids; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params }); FStar_Syntax_Syntax.sigrng = (s1.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = @@ -9629,7 +9644,7 @@ let (get_n_binders : FStar_Syntax_Syntax.term -> (FStar_Syntax_Syntax.binder Prims.list * FStar_Syntax_Syntax.comp)) = fun env1 -> fun n -> fun t -> get_n_binders' env1 [] n t -let (uu___3791 : unit) = +let (uu___3793 : unit) = FStar_Compiler_Effect.op_Colon_Equals __get_n_binders get_n_binders' let (maybe_unfold_head_fv : FStar_TypeChecker_Env.env -> diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml index b0078c87d6e..2eee3bc57e6 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml @@ -3226,8 +3226,10 @@ let (head_matches_delta : "FStar.TypeChecker.Rel.norm_with_steps.1" steps env t in let uu___4 = - let uu___5 = FStar_Syntax_Util.eq_tm t t' in - uu___5 = FStar_Syntax_Util.Equal in + let uu___5 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t + t' in + uu___5 = FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___4 then FStar_Pervasives_Native.None else @@ -3269,8 +3271,10 @@ let (head_matches_delta : match uu___ with | (head, head') -> let uu___1 = - let uu___2 = FStar_Syntax_Util.eq_tm head head' in - uu___2 = FStar_Syntax_Util.Equal in + let uu___2 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env head + head' in + uu___2 = FStar_TypeChecker_TermEqAndSimplify.Equal in Prims.op_Negation uu___1 in let rec aux retry n_delta t11 t21 = let r = head_matches env t11 t21 in @@ -6563,8 +6567,7 @@ and (solve_binders : match (a1, a2) with | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit b1), FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Implicit b2)) -> - FStar_Syntax_Util.Equal + (FStar_Syntax_Syntax.Implicit b2)) -> true | uu___1 -> FStar_Syntax_Util.eq_bqual a1 a2 in let compat_positivity_qualifiers p1 p2 = match p_rel orig with @@ -6591,10 +6594,9 @@ and (solve_binders : (let formula = p_guard rhs_prob in ((FStar_Pervasives.Inl ([rhs_prob], formula)), wl2)))) | (x::xs1, y::ys1) when - (let uu___1 = - eq_bqual x.FStar_Syntax_Syntax.binder_qual - y.FStar_Syntax_Syntax.binder_qual in - uu___1 = FStar_Syntax_Util.Equal) && + (eq_bqual x.FStar_Syntax_Syntax.binder_qual + y.FStar_Syntax_Syntax.binder_qual) + && (compat_positivity_qualifiers x.FStar_Syntax_Syntax.binder_positivity y.FStar_Syntax_Syntax.binder_positivity) @@ -6862,8 +6864,10 @@ and (solve_t_flex_rigid_eq : (fun x -> fun y -> let uu___7 = - FStar_Syntax_Util.eq_tm x y in - uu___7 = FStar_Syntax_Util.Equal) + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env x y in + uu___7 = + FStar_TypeChecker_TermEqAndSimplify.Equal) b.FStar_Syntax_Syntax.binder_attrs a.FStar_Syntax_Syntax.aqual_attributes) | uu___6 -> false in @@ -7566,10 +7570,10 @@ and (solve_t_flex_rigid_eq : let uu___17 = FStar_Syntax_Util.ctx_uvar_typ ctx_uv in - FStar_Syntax_Util.eq_tm - t_head uu___17 in + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env t_head uu___17 in uu___16 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___15 then solve_sub_probs_if_head_types_equal @@ -8235,8 +8239,10 @@ and (solve_t' : tprob -> worklist -> solution) = else (let uu___5 = (nargs = Prims.int_zero) || - (let uu___6 = FStar_Syntax_Util.eq_args args1 args2 in - uu___6 = FStar_Syntax_Util.Equal) in + (let uu___6 = + FStar_TypeChecker_TermEqAndSimplify.eq_args env + args1 args2 in + uu___6 = FStar_TypeChecker_TermEqAndSimplify.Equal) in if uu___5 then (if need_unif1 @@ -8440,19 +8446,21 @@ and (solve_t' : tprob -> worklist -> solution) = -> let uu___16 = let uu___17 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env1 head1' head1 in let uu___18 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env1 head2' head2 in (uu___17, uu___18) in (match uu___16 with - | (FStar_Syntax_Util.Equal, - FStar_Syntax_Util.Equal) + | (FStar_TypeChecker_TermEqAndSimplify.Equal, + FStar_TypeChecker_TermEqAndSimplify.Equal) -> ((let uu___18 = @@ -10734,11 +10742,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -10746,7 +10756,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -10755,8 +10764,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -10885,11 +10896,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -10897,7 +10910,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -10906,8 +10918,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11036,11 +11050,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11048,7 +11064,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11057,8 +11072,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11187,11 +11204,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11199,7 +11218,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11208,8 +11226,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11338,11 +11358,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11350,7 +11372,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11359,8 +11380,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11489,11 +11512,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11501,7 +11526,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11510,8 +11534,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11640,11 +11666,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11652,7 +11680,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11661,8 +11688,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11791,11 +11820,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11803,7 +11834,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11812,8 +11842,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11942,11 +11974,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11954,7 +11988,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11963,8 +11996,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -12093,11 +12128,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -12105,7 +12142,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -12114,8 +12150,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -12244,11 +12282,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -12256,7 +12296,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -12265,8 +12304,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -12395,11 +12436,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -12407,7 +12450,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -12416,8 +12458,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml index 58240a147d0..64ba6339849 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml @@ -5,6 +5,288 @@ let (unfold_whnf : = FStar_TypeChecker_Normalize.unfold_whnf' [FStar_TypeChecker_Env.AllowUnboundUniverses] +let (check_sig_inductive_injectivity_on_params : + FStar_TypeChecker_Env.env_t -> + FStar_Syntax_Syntax.sigelt -> FStar_Syntax_Syntax.sigelt) + = + fun tcenv -> + fun se -> + if tcenv.FStar_TypeChecker_Env.phase1 + then se + else + (let uu___1 = se.FStar_Syntax_Syntax.sigel in + match uu___1 with + | FStar_Syntax_Syntax.Sig_inductive_typ dd -> + let uu___2 = dd in + (match uu___2 with + | { FStar_Syntax_Syntax.lid = t; + FStar_Syntax_Syntax.us = universe_names; + FStar_Syntax_Syntax.params = tps; + FStar_Syntax_Syntax.num_uniform_params = uu___3; + FStar_Syntax_Syntax.t = k; + FStar_Syntax_Syntax.mutuals = uu___4; + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> + let t_lid = t in + let uu___7 = + FStar_Syntax_Subst.univ_var_opening universe_names in + (match uu___7 with + | (usubst, uvs) -> + let uu___8 = + let uu___9 = + FStar_TypeChecker_Env.push_univ_vars tcenv uvs in + let uu___10 = + FStar_Syntax_Subst.subst_binders usubst tps in + let uu___11 = + let uu___12 = + FStar_Syntax_Subst.shift_subst + (FStar_Compiler_List.length tps) usubst in + FStar_Syntax_Subst.subst uu___12 k in + (uu___9, uu___10, uu___11) in + (match uu___8 with + | (tcenv1, tps1, k1) -> + let uu___9 = FStar_Syntax_Subst.open_term tps1 k1 in + (match uu___9 with + | (tps2, k2) -> + let uu___10 = + FStar_Syntax_Util.arrow_formals k2 in + (match uu___10 with + | (uu___11, k3) -> + let uu___12 = + FStar_TypeChecker_TcTerm.tc_binders + tcenv1 tps2 in + (match uu___12 with + | (tps3, env_tps, uu___13, us) -> + let u_k = + let uu___14 = + let uu___15 = + FStar_Syntax_Syntax.fvar t + FStar_Pervasives_Native.None in + let uu___16 = + let uu___17 = + FStar_Syntax_Util.args_of_binders + tps3 in + FStar_Pervasives_Native.snd + uu___17 in + let uu___17 = + FStar_Ident.range_of_lid t in + FStar_Syntax_Syntax.mk_Tm_app + uu___15 uu___16 uu___17 in + FStar_TypeChecker_TcTerm.level_of_type + env_tps uu___14 k3 in + let rec universe_leq u v = + match (u, v) with + | (FStar_Syntax_Syntax.U_zero, + uu___14) -> true + | (FStar_Syntax_Syntax.U_succ + u0, + FStar_Syntax_Syntax.U_succ + v0) -> universe_leq u0 v0 + | (FStar_Syntax_Syntax.U_name + u0, + FStar_Syntax_Syntax.U_name + v0) -> + FStar_Ident.ident_equals u0 + v0 + | (FStar_Syntax_Syntax.U_name + uu___14, + FStar_Syntax_Syntax.U_succ + v0) -> universe_leq u v0 + | (FStar_Syntax_Syntax.U_max + us1, uu___14) -> + FStar_Compiler_Util.for_all + (fun u1 -> + universe_leq u1 v) us1 + | (uu___14, + FStar_Syntax_Syntax.U_max vs) + -> + FStar_Compiler_Util.for_some + (universe_leq u) vs + | (FStar_Syntax_Syntax.U_unknown, + uu___14) -> + let uu___15 = + let uu___16 = + FStar_Ident.string_of_lid + t in + let uu___17 = + FStar_Syntax_Print.univ_to_string + u in + let uu___18 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___16 uu___17 uu___18 in + FStar_Compiler_Effect.failwith + uu___15 + | (uu___14, + FStar_Syntax_Syntax.U_unknown) + -> + let uu___15 = + let uu___16 = + FStar_Ident.string_of_lid + t in + let uu___17 = + FStar_Syntax_Print.univ_to_string + u in + let uu___18 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___16 uu___17 uu___18 in + FStar_Compiler_Effect.failwith + uu___15 + | (FStar_Syntax_Syntax.U_unif + uu___14, uu___15) -> + let uu___16 = + let uu___17 = + FStar_Ident.string_of_lid + t in + let uu___18 = + FStar_Syntax_Print.univ_to_string + u in + let uu___19 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___17 uu___18 uu___19 in + FStar_Compiler_Effect.failwith + uu___16 + | (uu___14, + FStar_Syntax_Syntax.U_unif + uu___15) -> + let uu___16 = + let uu___17 = + FStar_Ident.string_of_lid + t in + let uu___18 = + FStar_Syntax_Print.univ_to_string + u in + let uu___19 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___17 uu___18 uu___19 in + FStar_Compiler_Effect.failwith + uu___16 + | uu___14 -> false in + let u_leq_u_k u = + let u1 = + FStar_TypeChecker_Normalize.normalize_universe + env_tps u in + universe_leq u1 u_k in + let tp_ok tp u_tp = + let t_tp = + (tp.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in + let uu___14 = u_leq_u_k u_tp in + if uu___14 + then true + else + (let t_tp1 = + FStar_TypeChecker_Normalize.normalize + [FStar_TypeChecker_Env.Unrefine; + FStar_TypeChecker_Env.Unascribe; + FStar_TypeChecker_Env.Unmeta; + FStar_TypeChecker_Env.Primops; + FStar_TypeChecker_Env.HNF; + FStar_TypeChecker_Env.UnfoldUntil + FStar_Syntax_Syntax.delta_constant; + FStar_TypeChecker_Env.Beta] + env_tps t_tp in + let uu___16 = + FStar_Syntax_Util.arrow_formals + t_tp1 in + match uu___16 with + | (formals, t1) -> + let uu___17 = + FStar_TypeChecker_TcTerm.tc_binders + env_tps formals in + (match uu___17 with + | (uu___18, uu___19, + uu___20, u_formals) + -> + let inj = + FStar_Compiler_Util.for_all + (fun u_formal -> + u_leq_u_k + u_formal) + u_formals in + if inj + then + let uu___21 = + let uu___22 = + FStar_Syntax_Subst.compress + t1 in + uu___22.FStar_Syntax_Syntax.n in + (match uu___21 + with + | FStar_Syntax_Syntax.Tm_type + u -> + u_leq_u_k u + | uu___22 -> + false) + else false)) in + let injective_type_params = + FStar_Compiler_List.forall2 + tp_ok tps3 us in + ((let uu___15 = + FStar_TypeChecker_Env.debug + tcenv1 + (FStar_Options.Other + "TcInductive") in + if uu___15 + then + let uu___16 = + FStar_Ident.string_of_lid t in + FStar_Compiler_Util.print2 + "%s injectivity for %s\n" + (if injective_type_params + then "YES" + else "NO") uu___16 + else ()); + { + FStar_Syntax_Syntax.sigel = + (FStar_Syntax_Syntax.Sig_inductive_typ + { + FStar_Syntax_Syntax.lid + = + (dd.FStar_Syntax_Syntax.lid); + FStar_Syntax_Syntax.us = + (dd.FStar_Syntax_Syntax.us); + FStar_Syntax_Syntax.params + = + (dd.FStar_Syntax_Syntax.params); + FStar_Syntax_Syntax.num_uniform_params + = + (dd.FStar_Syntax_Syntax.num_uniform_params); + FStar_Syntax_Syntax.t = + (dd.FStar_Syntax_Syntax.t); + FStar_Syntax_Syntax.mutuals + = + (dd.FStar_Syntax_Syntax.mutuals); + FStar_Syntax_Syntax.ds = + (dd.FStar_Syntax_Syntax.ds); + FStar_Syntax_Syntax.injective_type_params + = + injective_type_params + }); + FStar_Syntax_Syntax.sigrng = + (se.FStar_Syntax_Syntax.sigrng); + FStar_Syntax_Syntax.sigquals = + (se.FStar_Syntax_Syntax.sigquals); + FStar_Syntax_Syntax.sigmeta = + (se.FStar_Syntax_Syntax.sigmeta); + FStar_Syntax_Syntax.sigattrs = + (se.FStar_Syntax_Syntax.sigattrs); + FStar_Syntax_Syntax.sigopens_and_abbrevs + = + (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); + FStar_Syntax_Syntax.sigopts = + (se.FStar_Syntax_Syntax.sigopts) + })))))))) let (tc_tycon : FStar_TypeChecker_Env.env_t -> FStar_Syntax_Syntax.sigelt -> @@ -19,36 +301,37 @@ let (tc_tycon : FStar_Syntax_Syntax.params = tps; FStar_Syntax_Syntax.num_uniform_params = n_uniform; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = mutuals; - FStar_Syntax_Syntax.ds = data;_} + FStar_Syntax_Syntax.ds = data; + FStar_Syntax_Syntax.injective_type_params = uu___;_} -> let env0 = env in - let uu___ = FStar_Syntax_Subst.univ_var_opening uvs in - (match uu___ with + let uu___1 = FStar_Syntax_Subst.univ_var_opening uvs in + (match uu___1 with | (usubst, uvs1) -> - let uu___1 = - let uu___2 = FStar_TypeChecker_Env.push_univ_vars env uvs1 in - let uu___3 = FStar_Syntax_Subst.subst_binders usubst tps in - let uu___4 = - let uu___5 = + let uu___2 = + let uu___3 = FStar_TypeChecker_Env.push_univ_vars env uvs1 in + let uu___4 = FStar_Syntax_Subst.subst_binders usubst tps in + let uu___5 = + let uu___6 = FStar_Syntax_Subst.shift_subst (FStar_Compiler_List.length tps) usubst in - FStar_Syntax_Subst.subst uu___5 k in - (uu___2, uu___3, uu___4) in - (match uu___1 with + FStar_Syntax_Subst.subst uu___6 k in + (uu___3, uu___4, uu___5) in + (match uu___2 with | (env1, tps1, k1) -> - let uu___2 = FStar_Syntax_Subst.open_term tps1 k1 in - (match uu___2 with + let uu___3 = FStar_Syntax_Subst.open_term tps1 k1 in + (match uu___3 with | (tps2, k2) -> - let uu___3 = + let uu___4 = FStar_TypeChecker_TcTerm.tc_binders env1 tps2 in - (match uu___3 with + (match uu___4 with | (tps3, env_tps, guard_params, us) -> - let uu___4 = - let uu___5 = + let uu___5 = + let uu___6 = FStar_TypeChecker_TcTerm.tc_tot_or_gtot_term env_tps k2 in - match uu___5 with - | (k3, uu___6, g) -> + match uu___6 with + | (k3, uu___7, g) -> let k4 = FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Env.Exclude @@ -60,23 +343,23 @@ let (tc_tycon : FStar_TypeChecker_Env.Exclude FStar_TypeChecker_Env.Beta] env_tps k3 in - let uu___7 = - FStar_Syntax_Util.arrow_formals k4 in let uu___8 = - let uu___9 = + FStar_Syntax_Util.arrow_formals k4 in + let uu___9 = + let uu___10 = FStar_TypeChecker_Env.conj_guard guard_params g in FStar_TypeChecker_Rel.discharge_guard - env_tps uu___9 in - (uu___7, uu___8) in - (match uu___4 with + env_tps uu___10 in + (uu___8, uu___9) in + (match uu___5 with | ((indices, t), guard) -> let k3 = - let uu___5 = + let uu___6 = FStar_Syntax_Syntax.mk_Total t in - FStar_Syntax_Util.arrow indices uu___5 in - let uu___5 = FStar_Syntax_Util.type_u () in - (match uu___5 with + FStar_Syntax_Util.arrow indices uu___6 in + let uu___6 = FStar_Syntax_Util.type_u () in + (match uu___6 with | (t_type, u) -> let valid_type = (((FStar_Syntax_Util.is_eqtype_no_unrefine @@ -96,21 +379,21 @@ let (tc_tycon : env1 t t_type) in (if Prims.op_Negation valid_type then - (let uu___7 = - let uu___8 = - let uu___9 = + (let uu___8 = + let uu___9 = + let uu___10 = FStar_Syntax_Print.term_to_string t in - let uu___10 = + let uu___11 = FStar_Ident.string_of_lid tc in FStar_Compiler_Util.format2 "Type annotation %s for inductive %s is not Type or eqtype, or it is eqtype but contains noeq/unopteq qualifiers" - uu___9 uu___10 in + uu___10 uu___11 in (FStar_Errors_Codes.Error_InductiveAnnotNotAType, - uu___8) in + uu___9) in FStar_Errors.raise_error_text - uu___7 + uu___8 s.FStar_Syntax_Syntax.sigrng) else (); (let usubst1 = @@ -120,22 +403,22 @@ let (tc_tycon : FStar_TypeChecker_Util.close_guard_implicits env1 false tps3 guard in let t_tc = - let uu___7 = - let uu___8 = + let uu___8 = + let uu___9 = FStar_Syntax_Subst.subst_binders usubst1 tps3 in - let uu___9 = - let uu___10 = + let uu___10 = + let uu___11 = FStar_Syntax_Subst.shift_subst (FStar_Compiler_List.length tps3) usubst1 in FStar_Syntax_Subst.subst_binders - uu___10 indices in + uu___11 indices in FStar_Compiler_List.op_At - uu___8 uu___9 in - let uu___8 = - let uu___9 = - let uu___10 = + uu___9 uu___10 in + let uu___9 = + let uu___10 = + let uu___11 = FStar_Syntax_Subst.shift_subst ((FStar_Compiler_List.length tps3) @@ -143,46 +426,46 @@ let (tc_tycon : (FStar_Compiler_List.length indices)) usubst1 in FStar_Syntax_Subst.subst - uu___10 t in + uu___11 t in FStar_Syntax_Syntax.mk_Total - uu___9 in - FStar_Syntax_Util.arrow uu___7 - uu___8 in + uu___10 in + FStar_Syntax_Util.arrow uu___8 + uu___9 in let tps4 = FStar_Syntax_Subst.close_binders tps3 in let k4 = FStar_Syntax_Subst.close tps4 k3 in - let uu___7 = - let uu___8 = + let uu___8 = + let uu___9 = FStar_Syntax_Subst.subst_binders usubst1 tps4 in - let uu___9 = - let uu___10 = + let uu___10 = + let uu___11 = FStar_Syntax_Subst.shift_subst (FStar_Compiler_List.length tps4) usubst1 in FStar_Syntax_Subst.subst - uu___10 k4 in - (uu___8, uu___9) in - match uu___7 with + uu___11 k4 in + (uu___9, uu___10) in + match uu___8 with | (tps5, k5) -> let fv_tc = FStar_Syntax_Syntax.lid_as_fv tc FStar_Pervasives_Native.None in - let uu___8 = + let uu___9 = FStar_Syntax_Subst.open_univ_vars uvs1 t_tc in - (match uu___8 with + (match uu___9 with | (uvs2, t_tc1) -> - let uu___9 = + let uu___10 = FStar_TypeChecker_Env.push_let_binding env0 (FStar_Pervasives.Inr fv_tc) (uvs2, t_tc1) in - (uu___9, + (uu___10, { FStar_Syntax_Syntax.sigel = @@ -201,7 +484,9 @@ let (tc_tycon : FStar_Syntax_Syntax.mutuals = mutuals; FStar_Syntax_Syntax.ds - = data + = data; + FStar_Syntax_Syntax.injective_type_params + = false }); FStar_Syntax_Syntax.sigrng = @@ -245,47 +530,50 @@ let (tc_data : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = tc_lid; FStar_Syntax_Syntax.num_ty_params = ntps; - FStar_Syntax_Syntax.mutuals1 = mutual_tcs;_} + FStar_Syntax_Syntax.mutuals1 = mutual_tcs; + FStar_Syntax_Syntax.injective_type_params1 = uu___;_} -> - let uu___ = FStar_Syntax_Subst.univ_var_opening _uvs in - (match uu___ with + let uu___1 = FStar_Syntax_Subst.univ_var_opening _uvs in + (match uu___1 with | (usubst, _uvs1) -> - let uu___1 = - let uu___2 = + let uu___2 = + let uu___3 = FStar_TypeChecker_Env.push_univ_vars env _uvs1 in - let uu___3 = FStar_Syntax_Subst.subst usubst t in - (uu___2, uu___3) in - (match uu___1 with + let uu___4 = FStar_Syntax_Subst.subst usubst t in + (uu___3, uu___4) in + (match uu___2 with | (env1, t1) -> - let uu___2 = + let uu___3 = let tps_u_opt = FStar_Compiler_Util.find_map tcs - (fun uu___3 -> - match uu___3 with + (fun uu___4 -> + match uu___4 with | (se1, u_tc) -> - let uu___4 = - let uu___5 = - let uu___6 = + let uu___5 = + let uu___6 = + let uu___7 = FStar_Syntax_Util.lid_of_sigelt se1 in - FStar_Compiler_Util.must uu___6 in - FStar_Ident.lid_equals tc_lid uu___5 in - if uu___4 + FStar_Compiler_Util.must uu___7 in + FStar_Ident.lid_equals tc_lid uu___6 in + if uu___5 then (match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_inductive_typ - { FStar_Syntax_Syntax.lid = uu___5; - FStar_Syntax_Syntax.us = uu___6; + { FStar_Syntax_Syntax.lid = uu___6; + FStar_Syntax_Syntax.us = uu___7; FStar_Syntax_Syntax.params = tps; FStar_Syntax_Syntax.num_uniform_params - = uu___7; - FStar_Syntax_Syntax.t = uu___8; + = uu___8; + FStar_Syntax_Syntax.t = uu___9; FStar_Syntax_Syntax.mutuals = - uu___9; - FStar_Syntax_Syntax.ds = uu___10;_} + uu___10; + FStar_Syntax_Syntax.ds = uu___11; + FStar_Syntax_Syntax.injective_type_params + = uu___12;_} -> let tps1 = - let uu___11 = + let uu___13 = FStar_Syntax_Subst.subst_binders usubst tps in FStar_Compiler_List.map @@ -304,37 +592,37 @@ let (tc_data : FStar_Syntax_Syntax.binder_attrs = (x.FStar_Syntax_Syntax.binder_attrs) - }) uu___11 in + }) uu___13 in let tps2 = FStar_Syntax_Subst.open_binders tps1 in - let uu___11 = - let uu___12 = + let uu___13 = + let uu___14 = FStar_TypeChecker_Env.push_binders env1 tps2 in - (uu___12, tps2, u_tc) in + (uu___14, tps2, u_tc) in FStar_Pervasives_Native.Some - uu___11 - | uu___5 -> + uu___13 + | uu___6 -> FStar_Compiler_Effect.failwith "Impossible") else FStar_Pervasives_Native.None) in match tps_u_opt with | FStar_Pervasives_Native.Some x -> x | FStar_Pervasives_Native.None -> - let uu___3 = + let uu___4 = FStar_Ident.lid_equals tc_lid FStar_Parser_Const.exn_lid in - if uu___3 + if uu___4 then (env1, [], FStar_Syntax_Syntax.U_zero) else FStar_Errors.raise_error (FStar_Errors_Codes.Fatal_UnexpectedDataConstructor, "Unexpected data constructor") se.FStar_Syntax_Syntax.sigrng in - (match uu___2 with + (match uu___3 with | (env2, tps, u_tc) -> - let uu___3 = + let uu___4 = let t2 = FStar_TypeChecker_Normalize.normalize (FStar_Compiler_List.op_At @@ -342,18 +630,18 @@ let (tc_data : [FStar_TypeChecker_Env.AllowUnboundUniverses]) env2 t1 in let t3 = FStar_Syntax_Util.canon_arrow t2 in - let uu___4 = - let uu___5 = FStar_Syntax_Subst.compress t3 in - uu___5.FStar_Syntax_Syntax.n in - match uu___4 with + let uu___5 = + let uu___6 = FStar_Syntax_Subst.compress t3 in + uu___6.FStar_Syntax_Syntax.n in + match uu___5 with | FStar_Syntax_Syntax.Tm_arrow { FStar_Syntax_Syntax.bs1 = bs; FStar_Syntax_Syntax.comp = res;_} -> - let uu___5 = + let uu___6 = FStar_Compiler_Util.first_N ntps bs in - (match uu___5 with - | (uu___6, bs') -> + (match uu___6 with + | (uu___7, bs') -> let t4 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_arrow @@ -364,71 +652,71 @@ let (tc_data : let subst = FStar_Compiler_List.mapi (fun i -> - fun uu___7 -> - match uu___7 with + fun uu___8 -> + match uu___8 with | { FStar_Syntax_Syntax.binder_bv = x; FStar_Syntax_Syntax.binder_qual - = uu___8; - FStar_Syntax_Syntax.binder_positivity = uu___9; + FStar_Syntax_Syntax.binder_positivity + = uu___10; FStar_Syntax_Syntax.binder_attrs - = uu___10;_} + = uu___11;_} -> FStar_Syntax_Syntax.DB ((ntps - (Prims.int_one + i)), x)) tps in - let uu___7 = - let uu___8 = + let uu___8 = + let uu___9 = FStar_Syntax_Subst.subst subst t4 in FStar_Syntax_Util.arrow_formals_comp - uu___8 in - (match uu___7 with + uu___9 in + (match uu___8 with | (bs1, c1) -> - let uu___8 = + let uu___9 = (FStar_Options.ml_ish ()) || (FStar_Syntax_Util.is_total_comp c1) in - if uu___8 + if uu___9 then (bs1, (FStar_Syntax_Util.comp_result c1)) else - (let uu___10 = + (let uu___11 = FStar_Ident.range_of_lid (FStar_Syntax_Util.comp_effect_name c1) in FStar_Errors.raise_error (FStar_Errors_Codes.Fatal_UnexpectedConstructorType, "Constructors cannot have effects") - uu___10))) - | uu___5 -> ([], t3) in - (match uu___3 with + uu___11))) + | uu___6 -> ([], t3) in + (match uu___4 with | (arguments, result) -> - ((let uu___5 = + ((let uu___6 = FStar_TypeChecker_Env.debug env2 FStar_Options.Low in - if uu___5 + if uu___6 then - let uu___6 = - FStar_Syntax_Print.lid_to_string c in let uu___7 = + FStar_Syntax_Print.lid_to_string c in + let uu___8 = FStar_Syntax_Print.binders_to_string "->" arguments in - let uu___8 = + let uu___9 = FStar_Syntax_Print.term_to_string result in FStar_Compiler_Util.print3 "Checking datacon %s : %s -> %s \n" - uu___6 uu___7 uu___8 + uu___7 uu___8 uu___9 else ()); - (let uu___5 = + (let uu___6 = FStar_TypeChecker_TcTerm.tc_tparams env2 arguments in - match uu___5 with + match uu___6 with | (arguments1, env', us) -> let type_u_tc = FStar_Syntax_Syntax.mk @@ -437,23 +725,23 @@ let (tc_data : let env'1 = FStar_TypeChecker_Env.set_expected_typ env' type_u_tc in - let uu___6 = + let uu___7 = FStar_TypeChecker_TcTerm.tc_trivial_guard env'1 result in - (match uu___6 with + (match uu___7 with | (result1, res_lcomp) -> - let uu___7 = + let uu___8 = FStar_Syntax_Util.head_and_args_full result1 in - (match uu___7 with + (match uu___8 with | (head, args) -> let g_uvs = - let uu___8 = - let uu___9 = + let uu___9 = + let uu___10 = FStar_Syntax_Subst.compress head in - uu___9.FStar_Syntax_Syntax.n in - match uu___8 with + uu___10.FStar_Syntax_Syntax.n in + match uu___9 with | FStar_Syntax_Syntax.Tm_uinst ({ FStar_Syntax_Syntax.n @@ -461,11 +749,11 @@ let (tc_data : FStar_Syntax_Syntax.Tm_fvar fv; FStar_Syntax_Syntax.pos - = uu___9; - FStar_Syntax_Syntax.vars = uu___10; + FStar_Syntax_Syntax.vars + = uu___11; FStar_Syntax_Syntax.hash_code - = uu___11;_}, + = uu___12;_}, tuvs) when FStar_Syntax_Syntax.fv_eq_lid @@ -482,15 +770,15 @@ let (tc_data : (fun g -> fun u1 -> fun u2 -> - let uu___12 + let uu___13 = - let uu___13 + let uu___14 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_type u1) FStar_Compiler_Range_Type.dummyRange in - let uu___14 + let uu___15 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_type @@ -499,10 +787,10 @@ let (tc_data : FStar_Compiler_Range_Type.dummyRange in FStar_TypeChecker_Rel.teq env'1 - uu___13 - uu___14 in + uu___14 + uu___15 in FStar_TypeChecker_Env.conj_guard - g uu___12) + g uu___13) FStar_TypeChecker_Env.trivial_guard tuvs _uvs1 else @@ -516,138 +804,138 @@ let (tc_data : fv tc_lid -> FStar_TypeChecker_Env.trivial_guard - | uu___9 -> - let uu___10 = - let uu___11 = - let uu___12 = + | uu___10 -> + let uu___11 = + let uu___12 = + let uu___13 = FStar_Syntax_Print.lid_to_string tc_lid in - let uu___13 = + let uu___14 = FStar_Syntax_Print.term_to_string head in FStar_Compiler_Util.format2 "Expected a constructor of type %s; got %s" - uu___12 uu___13 in + uu___13 uu___14 in (FStar_Errors_Codes.Fatal_UnexpectedConstructorType, - uu___11) in + uu___12) in FStar_Errors.raise_error - uu___10 + uu___11 se.FStar_Syntax_Syntax.sigrng in let g = FStar_Compiler_List.fold_left2 (fun g1 -> - fun uu___8 -> + fun uu___9 -> fun u_x -> - match uu___8 with + match uu___9 with | { FStar_Syntax_Syntax.binder_bv = x; FStar_Syntax_Syntax.binder_qual - = uu___9; - FStar_Syntax_Syntax.binder_positivity = uu___10; + FStar_Syntax_Syntax.binder_positivity + = uu___11; FStar_Syntax_Syntax.binder_attrs - = uu___11;_} + = uu___12;_} -> - let uu___12 = + let uu___13 = FStar_TypeChecker_Rel.universe_inequality u_x u_tc in FStar_TypeChecker_Env.conj_guard - g1 uu___12) + g1 uu___13) g_uvs arguments1 us in (FStar_Errors.stop_if_err (); (let p_args = - let uu___9 = + let uu___10 = FStar_Compiler_Util.first_N (FStar_Compiler_List.length tps) args in FStar_Pervasives_Native.fst - uu___9 in + uu___10 in FStar_Compiler_List.iter2 - (fun uu___10 -> - fun uu___11 -> - match (uu___10, - uu___11) + (fun uu___11 -> + fun uu___12 -> + match (uu___11, + uu___12) with | ({ FStar_Syntax_Syntax.binder_bv = bv; FStar_Syntax_Syntax.binder_qual - = uu___12; - FStar_Syntax_Syntax.binder_positivity = uu___13; + FStar_Syntax_Syntax.binder_positivity + = uu___14; FStar_Syntax_Syntax.binder_attrs - = uu___14;_}, - (t2, uu___15)) -> - let uu___16 = - let uu___17 = + = uu___15;_}, + (t2, uu___16)) -> + let uu___17 = + let uu___18 = FStar_Syntax_Subst.compress t2 in - uu___17.FStar_Syntax_Syntax.n in - (match uu___16 + uu___18.FStar_Syntax_Syntax.n in + (match uu___17 with | FStar_Syntax_Syntax.Tm_name bv' when FStar_Syntax_Syntax.bv_eq bv bv' -> () - | uu___17 -> - let uu___18 - = - let uu___19 + | uu___18 -> + let uu___19 = let uu___20 = + let uu___21 + = FStar_Syntax_Print.bv_to_string bv in - let uu___21 + let uu___22 = FStar_Syntax_Print.term_to_string t2 in FStar_Compiler_Util.format2 "This parameter is not constant: expected %s, got %s" - uu___20 - uu___21 in + uu___21 + uu___22 in (FStar_Errors_Codes.Error_BadInductiveParam, - uu___19) in + uu___20) in FStar_Errors.raise_error - uu___18 + uu___19 t2.FStar_Syntax_Syntax.pos)) tps p_args; (let ty = - let uu___10 = + let uu___11 = unfold_whnf env2 res_lcomp.FStar_TypeChecker_Common.res_typ in FStar_Syntax_Util.unrefine - uu___10 in - (let uu___11 = - let uu___12 = + uu___11 in + (let uu___12 = + let uu___13 = FStar_Syntax_Subst.compress ty in - uu___12.FStar_Syntax_Syntax.n in - match uu___11 with + uu___13.FStar_Syntax_Syntax.n in + match uu___12 with | FStar_Syntax_Syntax.Tm_type - uu___12 -> () - | uu___12 -> - let uu___13 = - let uu___14 = - let uu___15 = + uu___13 -> () + | uu___13 -> + let uu___14 = + let uu___15 = + let uu___16 = FStar_Syntax_Print.term_to_string result1 in - let uu___16 = + let uu___17 = FStar_Syntax_Print.term_to_string ty in FStar_Compiler_Util.format2 "The type of %s is %s, but since this is the result type of a constructor its type should be Type" - uu___15 uu___16 in + uu___16 uu___17 in (FStar_Errors_Codes.Fatal_WrongResultTypeAfterConstrutor, - uu___14) in + uu___15) in FStar_Errors.raise_error - uu___13 + uu___14 se.FStar_Syntax_Syntax.sigrng); (let t2 = - let uu___11 = - let uu___12 = + let uu___12 = + let uu___13 = FStar_Compiler_List.map (fun b -> { @@ -667,12 +955,12 @@ let (tc_data : (b.FStar_Syntax_Syntax.binder_attrs) }) tps in FStar_Compiler_List.op_At - uu___12 arguments1 in - let uu___12 = + uu___13 arguments1 in + let uu___13 = FStar_Syntax_Syntax.mk_Total result1 in FStar_Syntax_Util.arrow - uu___11 uu___12 in + uu___12 uu___13 in let t3 = FStar_Syntax_Subst.close_univ_vars _uvs1 t2 in @@ -692,7 +980,9 @@ let (tc_data : FStar_Syntax_Syntax.num_ty_params = ntps; FStar_Syntax_Syntax.mutuals1 - = mutual_tcs + = mutual_tcs; + FStar_Syntax_Syntax.injective_type_params1 + = false }); FStar_Syntax_Syntax.sigrng = @@ -737,12 +1027,13 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.num_uniform_params = uu___4; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_} + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_} -> - let uu___7 = - let uu___8 = FStar_Syntax_Syntax.mk_Total k in - FStar_Syntax_Util.arrow tps uu___8 in - FStar_Syntax_Syntax.null_binder uu___7 + let uu___8 = + let uu___9 = FStar_Syntax_Syntax.mk_Total k in + FStar_Syntax_Util.arrow tps uu___9 in + FStar_Syntax_Syntax.null_binder uu___8 | uu___2 -> FStar_Compiler_Effect.failwith "Impossible")) tcs in let binders' = @@ -755,7 +1046,8 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_} + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> FStar_Syntax_Syntax.null_binder t | uu___ -> FStar_Compiler_Effect.failwith "Impossible") datas in let t = @@ -828,19 +1120,21 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.mutuals = mutuals; FStar_Syntax_Syntax.ds = - datas1;_} + datas1; + FStar_Syntax_Syntax.injective_type_params + = uu___15;_} -> let ty = FStar_Syntax_Subst.close_univ_vars uvs1 x.FStar_Syntax_Syntax.sort in - let uu___15 = - let uu___16 = - let uu___17 = + let uu___16 = + let uu___17 = + let uu___18 = FStar_Syntax_Subst.compress ty in - uu___17.FStar_Syntax_Syntax.n in - match uu___16 with + uu___18.FStar_Syntax_Syntax.n in + match uu___17 with | FStar_Syntax_Syntax.Tm_arrow { FStar_Syntax_Syntax.bs1 @@ -848,18 +1142,18 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.comp = c;_} -> - let uu___17 = + let uu___18 = FStar_Compiler_Util.first_N (FStar_Compiler_List.length tps) binders1 in - (match uu___17 with + (match uu___18 with | (tps1, rest) -> let t3 = match rest with | [] -> FStar_Syntax_Util.comp_result c - | uu___18 -> + | uu___19 -> FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_arrow { @@ -870,8 +1164,8 @@ let (generalize_and_inst_within : }) (x.FStar_Syntax_Syntax.sort).FStar_Syntax_Syntax.pos in (tps1, t3)) - | uu___17 -> ([], ty) in - (match uu___15 with + | uu___18 -> ([], ty) in + (match uu___16 with | (tps1, t3) -> { FStar_Syntax_Syntax.sigel @@ -891,7 +1185,9 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.mutuals = mutuals; FStar_Syntax_Syntax.ds - = datas1 + = datas1; + FStar_Syntax_Syntax.injective_type_params + = false }); FStar_Syntax_Syntax.sigrng = @@ -945,19 +1241,21 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.mutuals = uu___13; FStar_Syntax_Syntax.ds = - uu___14;_}; + uu___14; + FStar_Syntax_Syntax.injective_type_params + = uu___15;_}; FStar_Syntax_Syntax.sigrng = - uu___15; - FStar_Syntax_Syntax.sigquals = uu___16; - FStar_Syntax_Syntax.sigmeta = + FStar_Syntax_Syntax.sigquals = uu___17; - FStar_Syntax_Syntax.sigattrs = + FStar_Syntax_Syntax.sigmeta = uu___18; + FStar_Syntax_Syntax.sigattrs = + uu___19; FStar_Syntax_Syntax.sigopens_and_abbrevs - = uu___19; + = uu___20; FStar_Syntax_Syntax.sigopts = - uu___20;_} + uu___21;_} -> (tc, uvs_universes) | uu___9 -> FStar_Compiler_Effect.failwith @@ -991,15 +1289,17 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.num_ty_params = ntps; FStar_Syntax_Syntax.mutuals1 - = mutuals;_} + = mutuals; + FStar_Syntax_Syntax.injective_type_params1 + = uu___14;_} -> let ty = - let uu___14 = + let uu___15 = FStar_Syntax_InstFV.instantiate tc_insts t3.FStar_Syntax_Syntax.sort in FStar_Syntax_Subst.close_univ_vars - uvs1 uu___14 in + uvs1 uu___15 in { FStar_Syntax_Syntax.sigel = @@ -1016,7 +1316,9 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.num_ty_params = ntps; FStar_Syntax_Syntax.mutuals1 - = mutuals + = mutuals; + FStar_Syntax_Syntax.injective_type_params1 + = false }); FStar_Syntax_Syntax.sigrng = @@ -1049,7 +1351,8 @@ let (datacon_typ : FStar_Syntax_Syntax.sigelt -> FStar_Syntax_Syntax.term) = { FStar_Syntax_Syntax.lid1 = uu___; FStar_Syntax_Syntax.us1 = uu___1; FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_} + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> t | uu___ -> FStar_Compiler_Effect.failwith "Impossible!" let (haseq_suffix : Prims.string) = "__uu___haseq" @@ -1102,7 +1405,8 @@ let (get_optimized_haseq_axiom : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = uu___3; - FStar_Syntax_Syntax.ds = uu___4;_} + FStar_Syntax_Syntax.ds = uu___4; + FStar_Syntax_Syntax.injective_type_params = uu___5;_} -> (lid, bs, t) | uu___1 -> FStar_Compiler_Effect.failwith "Impossible!" in match uu___ with @@ -1359,7 +1663,8 @@ let (optimized_haseq_ty : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = uu___3; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> lid1 | uu___ -> FStar_Compiler_Effect.failwith "Impossible!" in let uu___ = acc in @@ -1387,7 +1692,9 @@ let (optimized_haseq_ty : FStar_Syntax_Syntax.ty_lid = t_lid; FStar_Syntax_Syntax.num_ty_params = uu___9; - FStar_Syntax_Syntax.mutuals1 = uu___10;_} + FStar_Syntax_Syntax.mutuals1 = uu___10; + FStar_Syntax_Syntax.injective_type_params1 + = uu___11;_} -> t_lid = lid | uu___6 -> FStar_Compiler_Effect.failwith @@ -1425,7 +1732,8 @@ let (optimized_haseq_scheme : FStar_Syntax_Syntax.num_uniform_params = uu___3; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> (us, t) | uu___1 -> FStar_Compiler_Effect.failwith "Impossible!" in match uu___ with @@ -1652,7 +1960,8 @@ let (unoptimized_haseq_ty : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = uu___3; - FStar_Syntax_Syntax.ds = d_lids;_} + FStar_Syntax_Syntax.ds = d_lids; + FStar_Syntax_Syntax.injective_type_params = uu___4;_} -> (lid, bs, t, d_lids) | uu___1 -> FStar_Compiler_Effect.failwith "Impossible!" in match uu___ with @@ -1715,7 +2024,9 @@ let (unoptimized_haseq_ty : FStar_Syntax_Syntax.ty_lid = t_lid; FStar_Syntax_Syntax.num_ty_params = uu___5; - FStar_Syntax_Syntax.mutuals1 = uu___6;_} + FStar_Syntax_Syntax.mutuals1 = uu___6; + FStar_Syntax_Syntax.injective_type_params1 + = uu___7;_} -> t_lid = lid | uu___2 -> FStar_Compiler_Effect.failwith "Impossible") @@ -1820,7 +2131,8 @@ let (unoptimized_haseq_scheme : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = uu___3; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> lid | uu___ -> FStar_Compiler_Effect.failwith "Impossible!") tcs in let uu___ = @@ -1832,7 +2144,8 @@ let (unoptimized_haseq_scheme : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = uu___3; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> (lid, us) | uu___1 -> FStar_Compiler_Effect.failwith "Impossible!" in match uu___ with @@ -1933,7 +2246,9 @@ let (check_inductive_well_typedness : FStar_Syntax_Syntax.num_uniform_params = uu___6; FStar_Syntax_Syntax.t = uu___7; FStar_Syntax_Syntax.mutuals = uu___8; - FStar_Syntax_Syntax.ds = uu___9;_} + FStar_Syntax_Syntax.ds = uu___9; + FStar_Syntax_Syntax.injective_type_params = + uu___10;_} -> uvs | uu___4 -> FStar_Compiler_Effect.failwith @@ -2045,49 +2360,51 @@ let (check_inductive_well_typedness : = num_uniform; FStar_Syntax_Syntax.t = typ; FStar_Syntax_Syntax.mutuals = ts; - FStar_Syntax_Syntax.ds = ds;_} + FStar_Syntax_Syntax.ds = ds; + FStar_Syntax_Syntax.injective_type_params + = uu___5;_} -> let fail expected inferred = - let uu___5 = - let uu___6 = - let uu___7 = + let uu___6 = + let uu___7 = + let uu___8 = FStar_Syntax_Print.tscheme_to_string expected in - let uu___8 = + let uu___9 = FStar_Syntax_Print.tscheme_to_string inferred in FStar_Compiler_Util.format2 "Expected an inductive with type %s; got %s" - uu___7 uu___8 in + uu___8 uu___9 in (FStar_Errors_Codes.Fatal_UnexpectedInductivetype, - uu___6) in - FStar_Errors.raise_error uu___5 + uu___7) in + FStar_Errors.raise_error uu___6 se.FStar_Syntax_Syntax.sigrng in let copy_binder_attrs_from_val binders1 expected = let expected_attrs = - let uu___5 = - let uu___6 = + let uu___6 = + let uu___7 = FStar_TypeChecker_Normalize.get_n_binders env1 (FStar_Compiler_List.length binders1) expected in FStar_Pervasives_Native.fst - uu___6 in + uu___7 in FStar_Compiler_List.map - (fun uu___6 -> - match uu___6 with + (fun uu___7 -> + match uu___7 with | { FStar_Syntax_Syntax.binder_bv - = uu___7; - FStar_Syntax_Syntax.binder_qual = uu___8; + FStar_Syntax_Syntax.binder_qual + = uu___9; FStar_Syntax_Syntax.binder_positivity = pqual; FStar_Syntax_Syntax.binder_attrs = attrs;_} -> (attrs, pqual)) - uu___5 in + uu___6 in if (FStar_Compiler_List.length expected_attrs) @@ -2095,44 +2412,44 @@ let (check_inductive_well_typedness : (FStar_Compiler_List.length binders1) then - let uu___5 = - let uu___6 = - let uu___7 = + let uu___6 = + let uu___7 = + let uu___8 = FStar_Compiler_Util.string_of_int (FStar_Compiler_List.length binders1) in - let uu___8 = + let uu___9 = FStar_Syntax_Print.term_to_string expected in FStar_Compiler_Util.format2 "Could not get %s type parameters from val type %s" - uu___7 uu___8 in + uu___8 uu___9 in (FStar_Errors_Codes.Fatal_UnexpectedInductivetype, - uu___6) in - FStar_Errors.raise_error uu___5 + uu___7) in + FStar_Errors.raise_error uu___6 se.FStar_Syntax_Syntax.sigrng else FStar_Compiler_List.map2 - (fun uu___6 -> + (fun uu___7 -> fun b -> - match uu___6 with + match uu___7 with | (ex_attrs, pqual) -> - ((let uu___8 = - let uu___9 = + ((let uu___9 = + let uu___10 = FStar_TypeChecker_Common.check_positivity_qual true pqual b.FStar_Syntax_Syntax.binder_positivity in Prims.op_Negation - uu___9 in - if uu___8 + uu___10 in + if uu___9 then - let uu___9 = + let uu___10 = FStar_Syntax_Syntax.range_of_bv b.FStar_Syntax_Syntax.binder_bv in FStar_Errors.raise_error (FStar_Errors_Codes.Fatal_UnexpectedInductivetype, "Incompatible positivity annotation") - uu___9 + uu___10 else ()); { FStar_Syntax_Syntax.binder_bv @@ -2155,32 +2472,32 @@ let (check_inductive_well_typedness : let body = match binders1 with | [] -> typ - | uu___5 -> - let uu___6 = - let uu___7 = - let uu___8 = + | uu___6 -> + let uu___7 = + let uu___8 = + let uu___9 = FStar_Syntax_Syntax.mk_Total typ in { FStar_Syntax_Syntax.bs1 = binders1; FStar_Syntax_Syntax.comp - = uu___8 + = uu___9 } in FStar_Syntax_Syntax.Tm_arrow - uu___7 in + uu___8 in FStar_Syntax_Syntax.mk - uu___6 + uu___7 se.FStar_Syntax_Syntax.sigrng in (univs1, body) in - let uu___5 = + let uu___6 = FStar_TypeChecker_Env.try_lookup_val_decl env0 l in - (match uu___5 with + (match uu___6 with | FStar_Pervasives_Native.None -> se | FStar_Pervasives_Native.Some - (expected_typ, uu___6) -> + (expected_typ, uu___7) -> if (FStar_Compiler_List.length univs1) @@ -2189,32 +2506,32 @@ let (check_inductive_well_typedness : (FStar_Pervasives_Native.fst expected_typ)) then - let uu___7 = + let uu___8 = FStar_Syntax_Subst.open_univ_vars univs1 (FStar_Pervasives_Native.snd expected_typ) in - (match uu___7 with - | (uu___8, expected) -> + (match uu___8 with + | (uu___9, expected) -> let binders1 = copy_binder_attrs_from_val binders expected in let inferred_typ = inferred_typ_with_binders binders1 in - let uu___9 = + let uu___10 = FStar_Syntax_Subst.open_univ_vars univs1 (FStar_Pervasives_Native.snd inferred_typ) in - (match uu___9 with - | (uu___10, inferred) + (match uu___10 with + | (uu___11, inferred) -> - let uu___11 = + let uu___12 = FStar_TypeChecker_Rel.teq_nosmt_force env0 inferred expected in - if uu___11 + if uu___12 then { FStar_Syntax_Syntax.sigel @@ -2236,7 +2553,9 @@ let (check_inductive_well_typedness : FStar_Syntax_Syntax.mutuals = ts; FStar_Syntax_Syntax.ds - = ds + = ds; + FStar_Syntax_Syntax.injective_type_params + = false }); FStar_Syntax_Syntax.sigrng = @@ -2261,11 +2580,94 @@ let (check_inductive_well_typedness : fail expected_typ inferred_typ)) else - (let uu___8 = + (let uu___9 = inferred_typ_with_binders binders in - fail expected_typ uu___8)) + fail expected_typ uu___9)) | uu___5 -> se) tcs1 in + let tcs3 = + FStar_Compiler_List.map + (check_sig_inductive_injectivity_on_params + env0) tcs2 in + let is_injective l = + let uu___5 = + FStar_Compiler_List.tryPick + (fun se -> + let uu___6 = + se.FStar_Syntax_Syntax.sigel in + match uu___6 with + | FStar_Syntax_Syntax.Sig_inductive_typ + { FStar_Syntax_Syntax.lid = lid; + FStar_Syntax_Syntax.us = uu___7; + FStar_Syntax_Syntax.params = + uu___8; + FStar_Syntax_Syntax.num_uniform_params + = uu___9; + FStar_Syntax_Syntax.t = uu___10; + FStar_Syntax_Syntax.mutuals = + uu___11; + FStar_Syntax_Syntax.ds = uu___12; + FStar_Syntax_Syntax.injective_type_params + = injective_type_params;_} + -> + let uu___13 = + FStar_Ident.lid_equals l lid in + if uu___13 + then + FStar_Pervasives_Native.Some + injective_type_params + else FStar_Pervasives_Native.None) + tcs3 in + match uu___5 with + | FStar_Pervasives_Native.None -> false + | FStar_Pervasives_Native.Some i -> i in + let datas3 = + FStar_Compiler_List.map + (fun se -> + let uu___5 = + se.FStar_Syntax_Syntax.sigel in + match uu___5 with + | FStar_Syntax_Syntax.Sig_datacon dd -> + let uu___6 = + let uu___7 = + let uu___8 = + is_injective + dd.FStar_Syntax_Syntax.ty_lid in + { + FStar_Syntax_Syntax.lid1 = + (dd.FStar_Syntax_Syntax.lid1); + FStar_Syntax_Syntax.us1 = + (dd.FStar_Syntax_Syntax.us1); + FStar_Syntax_Syntax.t1 = + (dd.FStar_Syntax_Syntax.t1); + FStar_Syntax_Syntax.ty_lid = + (dd.FStar_Syntax_Syntax.ty_lid); + FStar_Syntax_Syntax.num_ty_params + = + (dd.FStar_Syntax_Syntax.num_ty_params); + FStar_Syntax_Syntax.mutuals1 = + (dd.FStar_Syntax_Syntax.mutuals1); + FStar_Syntax_Syntax.injective_type_params1 + = uu___8 + } in + FStar_Syntax_Syntax.Sig_datacon + uu___7 in + { + FStar_Syntax_Syntax.sigel = uu___6; + FStar_Syntax_Syntax.sigrng = + (se.FStar_Syntax_Syntax.sigrng); + FStar_Syntax_Syntax.sigquals = + (se.FStar_Syntax_Syntax.sigquals); + FStar_Syntax_Syntax.sigmeta = + (se.FStar_Syntax_Syntax.sigmeta); + FStar_Syntax_Syntax.sigattrs = + (se.FStar_Syntax_Syntax.sigattrs); + FStar_Syntax_Syntax.sigopens_and_abbrevs + = + (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); + FStar_Syntax_Syntax.sigopts = + (se.FStar_Syntax_Syntax.sigopts) + }) datas2 in let sig_bndle = let uu___5 = FStar_TypeChecker_Env.get_range env0 in @@ -2278,8 +2680,8 @@ let (check_inductive_well_typedness : (FStar_Syntax_Syntax.Sig_bundle { FStar_Syntax_Syntax.ses = - (FStar_Compiler_List.op_At tcs2 - datas2); + (FStar_Compiler_List.op_At tcs3 + datas3); FStar_Syntax_Syntax.lids = lids }); FStar_Syntax_Syntax.sigrng = uu___5; @@ -2292,7 +2694,7 @@ let (check_inductive_well_typedness : FStar_Syntax_Syntax.sigopts = FStar_Pervasives_Native.None } in - (sig_bndle, tcs2, datas2))))) + (sig_bndle, tcs3, datas3))))) let (early_prims_inductives : Prims.string Prims.list) = ["empty"; "trivial"; "equals"; "pair"; "sum"] let (mk_discriminator_and_indexed_projectors : @@ -3156,142 +3558,145 @@ let (mk_data_operations : FStar_Syntax_Syntax.us1 = uvs; FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = typ_lid; FStar_Syntax_Syntax.num_ty_params = n_typars; - FStar_Syntax_Syntax.mutuals1 = uu___;_} + FStar_Syntax_Syntax.mutuals1 = uu___; + FStar_Syntax_Syntax.injective_type_params1 = uu___1;_} -> - let uu___1 = FStar_Syntax_Subst.univ_var_opening uvs in - (match uu___1 with + let uu___2 = FStar_Syntax_Subst.univ_var_opening uvs in + (match uu___2 with | (univ_opening, uvs1) -> let t1 = FStar_Syntax_Subst.subst univ_opening t in - let uu___2 = FStar_Syntax_Util.arrow_formals t1 in - (match uu___2 with - | (formals, uu___3) -> - let uu___4 = + let uu___3 = FStar_Syntax_Util.arrow_formals t1 in + (match uu___3 with + | (formals, uu___4) -> + let uu___5 = let tps_opt = FStar_Compiler_Util.find_map tcs (fun se1 -> - let uu___5 = - let uu___6 = - let uu___7 = + let uu___6 = + let uu___7 = + let uu___8 = FStar_Syntax_Util.lid_of_sigelt se1 in - FStar_Compiler_Util.must uu___7 in - FStar_Ident.lid_equals typ_lid uu___6 in - if uu___5 + FStar_Compiler_Util.must uu___8 in + FStar_Ident.lid_equals typ_lid uu___7 in + if uu___6 then match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_inductive_typ - { FStar_Syntax_Syntax.lid = uu___6; + { FStar_Syntax_Syntax.lid = uu___7; FStar_Syntax_Syntax.us = uvs'; FStar_Syntax_Syntax.params = tps; FStar_Syntax_Syntax.num_uniform_params - = uu___7; + = uu___8; FStar_Syntax_Syntax.t = typ0; FStar_Syntax_Syntax.mutuals = - uu___8; - FStar_Syntax_Syntax.ds = constrs;_} + uu___9; + FStar_Syntax_Syntax.ds = constrs; + FStar_Syntax_Syntax.injective_type_params + = uu___10;_} -> FStar_Pervasives_Native.Some (tps, typ0, ((FStar_Compiler_List.length constrs) > Prims.int_one)) - | uu___6 -> + | uu___7 -> FStar_Compiler_Effect.failwith "Impossible" else FStar_Pervasives_Native.None) in match tps_opt with | FStar_Pervasives_Native.Some x -> x | FStar_Pervasives_Native.None -> - let uu___5 = + let uu___6 = FStar_Ident.lid_equals typ_lid FStar_Parser_Const.exn_lid in - if uu___5 + if uu___6 then ([], FStar_Syntax_Util.ktype0, true) else FStar_Errors.raise_error (FStar_Errors_Codes.Fatal_UnexpectedDataConstructor, "Unexpected data constructor") se.FStar_Syntax_Syntax.sigrng in - (match uu___4 with + (match uu___5 with | (inductive_tps, typ0, should_refine) -> let inductive_tps1 = FStar_Syntax_Subst.subst_binders univ_opening inductive_tps in let typ01 = - let uu___5 = + let uu___6 = FStar_Syntax_Subst.shift_subst (FStar_Compiler_List.length inductive_tps1) univ_opening in - FStar_Syntax_Subst.subst uu___5 typ0 in - let uu___5 = + FStar_Syntax_Subst.subst uu___6 typ0 in + let uu___6 = FStar_Syntax_Util.arrow_formals typ01 in - (match uu___5 with - | (indices, uu___6) -> + (match uu___6 with + | (indices, uu___7) -> let refine_domain = - let uu___7 = + let uu___8 = FStar_Compiler_Util.for_some - (fun uu___8 -> - match uu___8 with + (fun uu___9 -> + match uu___9 with | FStar_Syntax_Syntax.RecordConstructor - uu___9 -> true - | uu___9 -> false) + uu___10 -> true + | uu___10 -> false) se.FStar_Syntax_Syntax.sigquals in - if uu___7 then false else should_refine in + if uu___8 then false else should_refine in let fv_qual = - let filter_records uu___7 = - match uu___7 with + let filter_records uu___8 = + match uu___8 with | FStar_Syntax_Syntax.RecordConstructor - (uu___8, fns) -> + (uu___9, fns) -> FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor (typ_lid, fns)) - | uu___8 -> + | uu___9 -> FStar_Pervasives_Native.None in - let uu___7 = + let uu___8 = FStar_Compiler_Util.find_map se.FStar_Syntax_Syntax.sigquals filter_records in - match uu___7 with + match uu___8 with | FStar_Pervasives_Native.None -> FStar_Syntax_Syntax.Data_ctor | FStar_Pervasives_Native.Some q -> q in let fields = - let uu___7 = + let uu___8 = FStar_Compiler_Util.first_N n_typars formals in - match uu___7 with + match uu___8 with | (imp_tps, fields1) -> let rename = FStar_Compiler_List.map2 - (fun uu___8 -> - fun uu___9 -> - match (uu___8, uu___9) + (fun uu___9 -> + fun uu___10 -> + match (uu___9, uu___10) with | ({ FStar_Syntax_Syntax.binder_bv = x; FStar_Syntax_Syntax.binder_qual - = uu___10; - FStar_Syntax_Syntax.binder_positivity = uu___11; + FStar_Syntax_Syntax.binder_positivity + = uu___12; FStar_Syntax_Syntax.binder_attrs - = uu___12;_}, + = uu___13;_}, { FStar_Syntax_Syntax.binder_bv = x'; FStar_Syntax_Syntax.binder_qual - = uu___13; - FStar_Syntax_Syntax.binder_positivity = uu___14; + FStar_Syntax_Syntax.binder_positivity + = uu___15; FStar_Syntax_Syntax.binder_attrs - = uu___15;_}) + = uu___16;_}) -> - let uu___16 = - let uu___17 = + let uu___17 = + let uu___18 = FStar_Syntax_Syntax.bv_to_name x' in - (x, uu___17) in + (x, uu___18) in FStar_Syntax_Syntax.NT - uu___16) imp_tps + uu___17) imp_tps inductive_tps1 in FStar_Syntax_Subst.subst_binders rename fields1 in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml index 5852a96f007..63243babb64 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml @@ -1341,8 +1341,10 @@ let (guard_letrecs : FStar_Syntax_Util.unrefine uu___ in let rec warn t11 t21 = let uu___ = - let uu___1 = FStar_Syntax_Util.eq_tm t11 t21 in - uu___1 = FStar_Syntax_Util.Equal in + let uu___1 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env2 t11 + t21 in + uu___1 = FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___ then false else @@ -1531,8 +1533,10 @@ let (guard_letrecs : uu___1 :: uu___2 in FStar_Syntax_Syntax.mk_Tm_app rel uu___ r in let uu___ = - let uu___1 = FStar_Syntax_Util.eq_tm rel rel_prev in - uu___1 = FStar_Syntax_Util.Equal in + let uu___1 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env2 rel + rel_prev in + uu___1 = FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___ then rel_guard else @@ -5994,7 +5998,7 @@ and (tc_abs_check_binders : let uu___2 = (Prims.op_Negation (special imp imp')) && (let uu___3 = FStar_Syntax_Util.eq_bqual imp imp' in - uu___3 <> FStar_Syntax_Util.Equal) in + Prims.op_Negation uu___3) in if uu___2 then let uu___3 = @@ -6126,9 +6130,10 @@ and (tc_abs_check_binders : FStar_Compiler_List.existsb (fun attr -> let uu___5 = - FStar_Syntax_Util.eq_tm attr - attr' in - uu___5 = FStar_Syntax_Util.Equal) + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env1 attr attr' in + uu___5 = + FStar_TypeChecker_TermEqAndSimplify.Equal) attrs1 in Prims.op_Negation uu___4) attrs'1 in FStar_Compiler_List.op_At attrs1 diff in From d950b26a32da33add7f9788e53cd3a8219cd6b2d Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Fri, 26 Apr 2024 23:41:28 -0700 Subject: [PATCH 122/239] tweak a test; we seemt to run out of stack a bit sooner on unembedding large lists; try to optimize eq_tm a bit --- examples/native_tactics/Simple.Test.fst | 2 +- .../FStar_TypeChecker_TermEqAndSimplify.ml | 106 +++++++----------- .../FStar.TypeChecker.TermEqAndSimplify.fst | 85 +++++++------- 3 files changed, 84 insertions(+), 109 deletions(-) diff --git a/examples/native_tactics/Simple.Test.fst b/examples/native_tactics/Simple.Test.fst index 566866fd193..a50465e818d 100644 --- a/examples/native_tactics/Simple.Test.fst +++ b/examples/native_tactics/Simple.Test.fst @@ -20,6 +20,6 @@ type t = | This | That let test0 = assert_norm (id 1000000 = 1000000) let test1 = assert_norm (poly_id 1000000 This = This) let test2 = assert_norm (mk_n_list 10 This = [This;This;This;This;This;This;This;This;This;This]) -let test3 = assert_norm (poly_list_id (mk_n_list 100000 This) = mk_n_list 100000 This) +let test3 = assert_norm (poly_list_id (mk_n_list 40000 This) = mk_n_list 40000 This) let test4 = assert_norm (eq_int_list (poly_list_id (mk_n_list 100000 0)) (mk_n_list 100000 0)) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml index b63e05a5320..e606fdf9d14 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml @@ -56,35 +56,37 @@ let rec (eq_tm : fun env -> fun t1 -> fun t2 -> - let eq_tm1 = eq_tm env in let t11 = FStar_Syntax_Util.canon_app t1 in let t21 = FStar_Syntax_Util.canon_app t2 in - let equal_data f1 parms1 args1 f2 parms2 args2 = + let equal_data f1 args1 f2 args2 n_parms = let uu___ = FStar_Syntax_Syntax.fv_eq f1 f2 in if uu___ then - (if - ((FStar_Compiler_List.length parms1) = - (FStar_Compiler_List.length parms2)) - && - ((FStar_Compiler_List.length args1) = - (FStar_Compiler_List.length args2)) + let n1 = FStar_Compiler_List.length args1 in + let n2 = FStar_Compiler_List.length args2 in + (if (n1 = n2) && (n_parms <= n1) then - let eq_arg_list as1 as2 = - FStar_Compiler_List.fold_left2 - (fun acc -> - fun uu___1 -> - fun uu___2 -> - match (uu___1, uu___2) with - | ((a1, q1), (a2, q2)) -> - let uu___3 = eq_tm1 a1 a2 in eq_inj acc uu___3) - Equal as1 as2 in - let args_eq = eq_arg_list args1 args2 in - (if args_eq = Equal - then - let parms_eq = eq_arg_list parms1 parms2 in - (if parms_eq = Equal then Equal else Unknown) - else args_eq) + let uu___1 = FStar_Compiler_List.splitAt n_parms args1 in + match uu___1 with + | (parms1, args11) -> + let uu___2 = FStar_Compiler_List.splitAt n_parms args2 in + (match uu___2 with + | (parms2, args21) -> + let eq_arg_list as1 as2 = + FStar_Compiler_List.fold_left2 + (fun acc -> + fun uu___3 -> + fun uu___4 -> + match (uu___3, uu___4) with + | ((a1, q1), (a2, q2)) -> + let uu___5 = eq_tm env a1 a2 in + eq_inj acc uu___5) Equal as1 as2 in + let args_eq = eq_arg_list args11 args21 in + if args_eq = Equal + then + let parms_eq = eq_arg_list parms1 parms2 in + (if parms_eq = Equal then Equal else Unknown) + else args_eq) else Unknown) else NotEqual in let qual_is_inj uu___ = @@ -120,34 +122,13 @@ let rec (eq_tm : (qual_is_inj g.FStar_Syntax_Syntax.fv_qual) -> let uu___3 = - let uu___4 = - let uu___5 = FStar_Syntax_Syntax.lid_of_fv f in - FStar_TypeChecker_Env.num_datacon_non_injective_ty_params - env uu___5 in - let uu___5 = - let uu___6 = FStar_Syntax_Syntax.lid_of_fv g in - FStar_TypeChecker_Env.num_datacon_non_injective_ty_params - env uu___6 in - (uu___4, uu___5) in + let uu___4 = FStar_Syntax_Syntax.lid_of_fv f in + FStar_TypeChecker_Env.num_datacon_non_injective_ty_params + env uu___4 in (match uu___3 with - | (FStar_Pervasives_Native.Some n1, - FStar_Pervasives_Native.Some n2) -> - if - (n1 <= (FStar_Compiler_List.length args1)) && - (n2 <= (FStar_Compiler_List.length args2)) - then - let uu___4 = - FStar_Compiler_List.splitAt n1 args1 in - (match uu___4 with - | (parms1, args11) -> - let uu___5 = - FStar_Compiler_List.splitAt n2 args2 in - (match uu___5 with - | (parms2, args21) -> - FStar_Pervasives_Native.Some - (f, parms1, args11, g, parms2, - args21))) - else FStar_Pervasives_Native.None + | FStar_Pervasives_Native.Some n -> + FStar_Pervasives_Native.Some + (f, args1, g, args2, n) | uu___4 -> FStar_Pervasives_Native.None) | uu___3 -> FStar_Pervasives_Native.None)) in let t12 = FStar_Syntax_Util.unmeta t11 in @@ -158,9 +139,9 @@ let rec (eq_tm : equal_if (bv1.FStar_Syntax_Syntax.index = bv2.FStar_Syntax_Syntax.index) | (FStar_Syntax_Syntax.Tm_lazy uu___, uu___1) -> - let uu___2 = FStar_Syntax_Util.unlazy t12 in eq_tm1 uu___2 t22 + let uu___2 = FStar_Syntax_Util.unlazy t12 in eq_tm env uu___2 t22 | (uu___, FStar_Syntax_Syntax.Tm_lazy uu___1) -> - let uu___2 = FStar_Syntax_Util.unlazy t22 in eq_tm1 t12 uu___2 + let uu___2 = FStar_Syntax_Util.unlazy t22 in eq_tm env t12 uu___2 | (FStar_Syntax_Syntax.Tm_name a, FStar_Syntax_Syntax.Tm_name b) -> let uu___ = FStar_Syntax_Syntax.bv_eq a b in equal_if uu___ | uu___ when @@ -170,13 +151,12 @@ let rec (eq_tm : let uu___1 = FStar_Compiler_Util.must heads_and_args_in_case_both_data in (match uu___1 with - | (f, parms1, args1, g, parms2, args2) -> - equal_data f parms1 args1 g parms2 args2) + | (f, args1, g, args2, n) -> equal_data f args1 g args2 n) | (FStar_Syntax_Syntax.Tm_fvar f, FStar_Syntax_Syntax.Tm_fvar g) -> let uu___ = FStar_Syntax_Syntax.fv_eq f g in equal_if uu___ | (FStar_Syntax_Syntax.Tm_uinst (f, us), FStar_Syntax_Syntax.Tm_uinst (g, vs)) -> - let uu___ = eq_tm1 f g in + let uu___ = eq_tm env f g in eq_and uu___ (fun uu___1 -> let uu___2 = FStar_Syntax_Util.eq_univs_list us vs in @@ -217,9 +197,9 @@ let rec (eq_tm : let uu___2 = FStar_Syntax_Syntax.lid_of_fv f1 in FStar_Ident.string_of_lid uu___2 in FStar_Compiler_List.mem uu___1 injectives) - -> equal_data f1 [] args1 f2 [] args2 + -> equal_data f1 args1 f2 args2 Prims.int_zero | uu___1 -> - let uu___2 = eq_tm1 h1 h2 in + let uu___2 = eq_tm env h1 h2 in eq_and uu___2 (fun uu___3 -> eq_args env args1 args2)) | (FStar_Syntax_Syntax.Tm_match { FStar_Syntax_Syntax.scrutinee = t13; @@ -237,7 +217,7 @@ let rec (eq_tm : (FStar_Compiler_List.length bs2) then let uu___4 = FStar_Compiler_List.zip bs1 bs2 in - let uu___5 = eq_tm1 t13 t23 in + let uu___5 = eq_tm env t13 t23 in FStar_Compiler_List.fold_right (fun uu___6 -> fun a -> @@ -256,9 +236,9 @@ let rec (eq_tm : { FStar_Syntax_Syntax.b = t23; FStar_Syntax_Syntax.phi = phi2;_}) -> let uu___ = - eq_tm1 t13.FStar_Syntax_Syntax.sort + eq_tm env t13.FStar_Syntax_Syntax.sort t23.FStar_Syntax_Syntax.sort in - eq_and uu___ (fun uu___1 -> eq_tm1 phi1 phi2) + eq_and uu___ (fun uu___1 -> eq_tm env phi1 phi2) | (FStar_Syntax_Syntax.Tm_abs { FStar_Syntax_Syntax.bs = bs1; FStar_Syntax_Syntax.body = body1; FStar_Syntax_Syntax.rc_opt = uu___;_}, @@ -276,11 +256,11 @@ let rec (eq_tm : fun b2 -> eq_and r (fun uu___3 -> - eq_tm1 + eq_tm env (b1.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort (b2.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort)) Equal bs1 bs2 in - eq_and uu___2 (fun uu___3 -> eq_tm1 body1 body2) + eq_and uu___2 (fun uu___3 -> eq_tm env body1 body2) | (FStar_Syntax_Syntax.Tm_arrow { FStar_Syntax_Syntax.bs1 = bs1; FStar_Syntax_Syntax.comp = c1;_}, FStar_Syntax_Syntax.Tm_arrow @@ -296,7 +276,7 @@ let rec (eq_tm : fun b2 -> eq_and r (fun uu___1 -> - eq_tm1 + eq_tm env (b1.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort (b2.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort)) Equal bs1 bs2 in diff --git a/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst b/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst index e7d5ae2cc4f..386d664457f 100644 --- a/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst +++ b/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst @@ -77,65 +77,60 @@ let eq_and r s = (* Precondition: terms are well-typed in a common environment, or this can return false positives *) let rec eq_tm (env:env_t) (t1:term) (t2:term) : eq_result = - let eq_tm = eq_tm env in let t1 = canon_app t1 in let t2 = canon_app t2 in - let equal_data (f1:fv) (parms1 args1:Syntax.args) (f2:fv) (parms2 args2:Syntax.args) = + let equal_data (f1:S.fv) (args1:Syntax.args) (f2:fv) (args2:Syntax.args) (n_parms:int) = // we got constructors! we know they are injective and disjoint, so we can do some // good analysis on them if fv_eq f1 f2 then ( - if List.length parms1 = List.length parms2 - && List.length args1 = List.length args2 + let n1 = List.length args1 in + let n2 = List.length args2 in + if n1 = n2 && n_parms <= n1 then ( + let parms1, args1 = List.splitAt n_parms args1 in + let parms2, args2 = List.splitAt n_parms args2 in let eq_arg_list as1 as2 = - List.fold_left2 - (fun acc (a1, q1) (a2, q2) -> - //if q1 <> q2 - //then failwith (U.format1 "Arguments of %s mismatch on implicit qualifier\n" - // (Ident.string_of_lid f1.fv_name.v)); - //NS: 05/06/2018 ...this does not always hold - // it's been succeeding because the assert is disabled in the non-debug builds - //assert (q1 = q2); - eq_inj acc (eq_tm a1 a2)) - Equal - as1 - as2 + List.fold_left2 + (fun acc (a1, q1) (a2, q2) -> + //if q1 <> q2 + //then failwith (U.format1 "Arguments of %s mismatch on implicit qualifier\n" + // (Ident.string_of_lid f1.fv_name.v)); + //NS: 05/06/2018 ...this does not always hold + // it's been succeeding because the assert is disabled in the non-debug builds + //assert (q1 = q2); + eq_inj acc (eq_tm env a1 a2)) + Equal + as1 + as2 in let args_eq = eq_arg_list args1 args2 in if args_eq = Equal - then let parms_eq = eq_arg_list parms1 parms2 in - if parms_eq = Equal - then Equal - else Unknown + then + let parms_eq = eq_arg_list parms1 parms2 in + if parms_eq = Equal + then Equal + else Unknown else args_eq ) else Unknown - ) else NotEqual + ) + else NotEqual in let qual_is_inj = function | Some Data_ctor | Some (Record_ctor _) -> true | _ -> false in - let heads_and_args_in_case_both_data :option (fv * args * args * fv * args * args) = + let heads_and_args_in_case_both_data : option (S.fv * args * S.fv * args * int) = let head1, args1 = t1 |> unmeta |> head_and_args in let head2, args2 = t2 |> unmeta |> head_and_args in match (un_uinst head1).n, (un_uinst head2).n with | Tm_fvar f, Tm_fvar g when qual_is_inj f.fv_qual && qual_is_inj g.fv_qual -> ( - match Env.num_datacon_non_injective_ty_params env (lid_of_fv f), - Env.num_datacon_non_injective_ty_params env (lid_of_fv g) with - | Some n1, Some n2 -> - if n1 <= List.length args1 - && n2 <= List.length args2 - then ( - let parms1, args1 = List.splitAt n1 args1 in - let parms2, args2 = List.splitAt n2 args2 in - Some (f, parms1, args1, g, parms2, args2) - ) - else None + match Env.num_datacon_non_injective_ty_params env (lid_of_fv f) with + | Some n -> Some (f, args1, g, args2, n) | _ -> None ) | _ -> None @@ -148,15 +143,15 @@ let rec eq_tm (env:env_t) (t1:term) (t2:term) : eq_result = | Tm_bvar bv1, Tm_bvar bv2 -> equal_if (bv1.index = bv2.index) - | Tm_lazy _, _ -> eq_tm (unlazy t1) t2 - | _, Tm_lazy _ -> eq_tm t1 (unlazy t2) + | Tm_lazy _, _ -> eq_tm env (unlazy t1) t2 + | _, Tm_lazy _ -> eq_tm env t1 (unlazy t2) | Tm_name a, Tm_name b -> equal_if (bv_eq a b) | _ when heads_and_args_in_case_both_data |> Some? -> //matches only when both are data constructors - heads_and_args_in_case_both_data |> must |> (fun (f, parms1, args1, g, parms2, args2) -> - equal_data f parms1 args1 g parms2 args2 + heads_and_args_in_case_both_data |> must |> (fun (f, args1, g, args2, n) -> + equal_data f args1 g args2 n ) | Tm_fvar f, Tm_fvar g -> equal_if (fv_eq f g) @@ -164,7 +159,7 @@ let rec eq_tm (env:env_t) (t1:term) (t2:term) : eq_result = | Tm_uinst(f, us), Tm_uinst(g, vs) -> // If the fvars and universe instantiations match, then Equal, // otherwise Unknown. - eq_and (eq_tm f g) (fun () -> equal_if (eq_univs_list us vs)) + eq_and (eq_tm env f g) (fun () -> equal_if (eq_univs_list us vs)) | Tm_constant (Const_range _), Tm_constant (Const_range _) -> // Ranges should be opaque, even to the normalizer. c.f. #1312 @@ -195,17 +190,17 @@ let rec eq_tm (env:env_t) (t1:term) (t2:term) : eq_result = | Tm_app {hd=h1; args=args1}, Tm_app {hd=h2; args=args2} -> begin match (un_uinst h1).n, (un_uinst h2).n with | Tm_fvar f1, Tm_fvar f2 when fv_eq f1 f2 && List.mem (string_of_lid (lid_of_fv f1)) injectives -> - equal_data f1 [] args1 f2 [] args2 + equal_data f1 args1 f2 args2 0 | _ -> // can only assert they're equal if they syntactically match, nothing else - eq_and (eq_tm h1 h2) (fun () -> eq_args env args1 args2) + eq_and (eq_tm env h1 h2) (fun () -> eq_args env args1 args2) end | Tm_match {scrutinee=t1; brs=bs1}, Tm_match {scrutinee=t2; brs=bs2} -> //AR: note: no return annotations if List.length bs1 = List.length bs2 then List.fold_right (fun (b1, b2) a -> eq_and a (fun () -> branch_matches env b1 b2)) (List.zip bs1 bs2) - (eq_tm t1 t2) + (eq_tm env t1 t2) else Unknown | Tm_type u, Tm_type v -> @@ -221,7 +216,7 @@ let rec eq_tm (env:env_t) (t1:term) (t2:term) : eq_result = Unknown | Tm_refine {b=t1; phi=phi1}, Tm_refine {b=t2; phi=phi2} -> - eq_and (eq_tm t1.sort t2.sort) (fun () -> eq_tm phi1 phi2) + eq_and (eq_tm env t1.sort t2.sort) (fun () -> eq_tm env phi1 phi2) (* * AR: ignoring residual comp here, that's an ascription added by the typechecker @@ -230,13 +225,13 @@ let rec eq_tm (env:env_t) (t1:term) (t2:term) : eq_result = | Tm_abs {bs=bs1; body=body1}, Tm_abs {bs=bs2; body=body2} when List.length bs1 = List.length bs2 -> - eq_and (List.fold_left2 (fun r b1 b2 -> eq_and r (fun () -> eq_tm b1.binder_bv.sort b2.binder_bv.sort)) + eq_and (List.fold_left2 (fun r b1 b2 -> eq_and r (fun () -> eq_tm env b1.binder_bv.sort b2.binder_bv.sort)) Equal bs1 bs2) - (fun () -> eq_tm body1 body2) + (fun () -> eq_tm env body1 body2) | Tm_arrow {bs=bs1; comp=c1}, Tm_arrow {bs=bs2; comp=c2} when List.length bs1 = List.length bs2 -> - eq_and (List.fold_left2 (fun r b1 b2 -> eq_and r (fun () -> eq_tm b1.binder_bv.sort b2.binder_bv.sort)) + eq_and (List.fold_left2 (fun r b1 b2 -> eq_and r (fun () -> eq_tm env b1.binder_bv.sort b2.binder_bv.sort)) Equal bs1 bs2) (fun () -> eq_comp env c1 c2) From 67c99f4b526910ad9da0bae50ac1d126296a61fc Mon Sep 17 00:00:00 2001 From: Aseem Rastogi Date: Sat, 27 Apr 2024 11:23:27 +0000 Subject: [PATCH 123/239] snap --- .../generated/FStar_SquashProperties.ml | 2 +- .../generated/FStar_Tactics_Hooks.ml | 27 +-- .../generated/FStar_ToSyntax_ToSyntax.ml | 159 ++++-------------- 3 files changed, 38 insertions(+), 150 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SquashProperties.ml b/ocaml/fstar-lib/generated/FStar_SquashProperties.ml index 141fc597d5b..3675bae54de 100644 --- a/ocaml/fstar-lib/generated/FStar_SquashProperties.ml +++ b/ocaml/fstar-lib/generated/FStar_SquashProperties.ml @@ -11,6 +11,6 @@ type ('a, 'b) retract_cond = | MkC of unit * unit * unit let uu___is_MkC : 'a 'b . ('a, 'b) retract_cond -> Prims.bool = fun projectee -> true -let false_elim : 'a . unit -> 'a = +let false_elim : 'a . Prims.l_False -> 'a = fun uu___ -> (fun f -> Obj.magic (failwith "unreachable")) uu___ type u = unit \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml index b4df33e30af..ec33a6ff865 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml @@ -1705,13 +1705,6 @@ let (handle_smt_goal : let fv = FStar_Syntax_Syntax.lid_as_fv lid FStar_Pervasives_Native.None in - let dd = - let uu___3 = - FStar_TypeChecker_Env.delta_depth_of_qninfo fv qn in - match uu___3 with - | FStar_Pervasives_Native.Some dd1 -> dd1 - | FStar_Pervasives_Native.None -> - FStar_Compiler_Effect.failwith "Expected a dd" in let uu___3 = FStar_Syntax_Syntax.lid_as_fv lid FStar_Pervasives_Native.None in @@ -2117,25 +2110,9 @@ let (splice : FStar_Syntax_Syntax.lbattrs = uu___11; FStar_Syntax_Syntax.lbpos = uu___12;_} -> - let uu___13 = - let uu___14 = - let uu___15 = - let uu___16 = - FStar_Syntax_Util.incr_delta_qualifier - lbdef in - FStar_Pervasives_Native.Some - uu___16 in - { - FStar_Syntax_Syntax.fv_name = - (fv.FStar_Syntax_Syntax.fv_name); - FStar_Syntax_Syntax.fv_delta = - uu___15; - FStar_Syntax_Syntax.fv_qual = - (fv.FStar_Syntax_Syntax.fv_qual) - } in - FStar_Pervasives.Inr uu___14 in { - FStar_Syntax_Syntax.lbname = uu___13; + FStar_Syntax_Syntax.lbname = + (FStar_Pervasives.Inr fv); FStar_Syntax_Syntax.lbunivs = (lb.FStar_Syntax_Syntax.lbunivs); FStar_Syntax_Syntax.lbtyp = diff --git a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml index 1fe7d79c2fa..ba0a0715fde 100644 --- a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml +++ b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml @@ -327,51 +327,31 @@ let (op_as_term : fun env -> fun arity -> fun op -> - let r l dd = + let r l = let uu___ = let uu___1 = let uu___2 = let uu___3 = FStar_Ident.range_of_id op in FStar_Ident.set_lid_range l uu___3 in - FStar_Syntax_Syntax.lid_and_dd_as_fv uu___2 dd + FStar_Syntax_Syntax.lid_and_dd_as_fv uu___2 FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___1 in FStar_Pervasives_Native.Some uu___ in let fallback uu___ = let uu___1 = FStar_Ident.string_of_id op in match uu___1 with - | "=" -> - r FStar_Parser_Const.op_Eq FStar_Syntax_Syntax.delta_equational - | "<" -> - r FStar_Parser_Const.op_LT FStar_Syntax_Syntax.delta_equational - | "<=" -> - r FStar_Parser_Const.op_LTE - FStar_Syntax_Syntax.delta_equational - | ">" -> - r FStar_Parser_Const.op_GT FStar_Syntax_Syntax.delta_equational - | ">=" -> - r FStar_Parser_Const.op_GTE - FStar_Syntax_Syntax.delta_equational - | "&&" -> - r FStar_Parser_Const.op_And - FStar_Syntax_Syntax.delta_equational - | "||" -> - r FStar_Parser_Const.op_Or FStar_Syntax_Syntax.delta_equational - | "+" -> - r FStar_Parser_Const.op_Addition - FStar_Syntax_Syntax.delta_equational - | "-" when arity = Prims.int_one -> - r FStar_Parser_Const.op_Minus - FStar_Syntax_Syntax.delta_equational - | "-" -> - r FStar_Parser_Const.op_Subtraction - FStar_Syntax_Syntax.delta_equational - | "/" -> - r FStar_Parser_Const.op_Division - FStar_Syntax_Syntax.delta_equational - | "%" -> - r FStar_Parser_Const.op_Modulus - FStar_Syntax_Syntax.delta_equational + | "=" -> r FStar_Parser_Const.op_Eq + | "<" -> r FStar_Parser_Const.op_LT + | "<=" -> r FStar_Parser_Const.op_LTE + | ">" -> r FStar_Parser_Const.op_GT + | ">=" -> r FStar_Parser_Const.op_GTE + | "&&" -> r FStar_Parser_Const.op_And + | "||" -> r FStar_Parser_Const.op_Or + | "+" -> r FStar_Parser_Const.op_Addition + | "-" when arity = Prims.int_one -> r FStar_Parser_Const.op_Minus + | "-" -> r FStar_Parser_Const.op_Subtraction + | "/" -> r FStar_Parser_Const.op_Division + | "%" -> r FStar_Parser_Const.op_Modulus | "@" -> ((let uu___3 = FStar_Ident.range_of_id op in let uu___4 = @@ -382,36 +362,15 @@ let (op_as_term : [uu___6] in (FStar_Errors_Codes.Warning_DeprecatedGeneric, uu___5) in FStar_Errors.log_issue_doc uu___3 uu___4); - r FStar_Parser_Const.list_tot_append_lid - (FStar_Syntax_Syntax.Delta_equational_at_level - (Prims.of_int (2)))) - | "<>" -> - r FStar_Parser_Const.op_notEq - FStar_Syntax_Syntax.delta_equational - | "~" -> - r FStar_Parser_Const.not_lid - (FStar_Syntax_Syntax.Delta_constant_at_level - (Prims.of_int (2))) - | "==" -> - r FStar_Parser_Const.eq2_lid - (FStar_Syntax_Syntax.Delta_constant_at_level - (Prims.of_int (2))) - | "<<" -> - r FStar_Parser_Const.precedes_lid - FStar_Syntax_Syntax.delta_constant - | "/\\" -> - r FStar_Parser_Const.and_lid - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) - | "\\/" -> - r FStar_Parser_Const.or_lid - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) - | "==>" -> - r FStar_Parser_Const.imp_lid - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) - | "<==>" -> - r FStar_Parser_Const.iff_lid - (FStar_Syntax_Syntax.Delta_constant_at_level - (Prims.of_int (2))) + r FStar_Parser_Const.list_tot_append_lid) + | "<>" -> r FStar_Parser_Const.op_notEq + | "~" -> r FStar_Parser_Const.not_lid + | "==" -> r FStar_Parser_Const.eq2_lid + | "<<" -> r FStar_Parser_Const.precedes_lid + | "/\\" -> r FStar_Parser_Const.and_lid + | "\\/" -> r FStar_Parser_Const.or_lid + | "==>" -> r FStar_Parser_Const.imp_lid + | "<==>" -> r FStar_Parser_Const.iff_lid | uu___2 -> FStar_Pervasives_Native.None in let uu___ = let uu___1 = @@ -2039,7 +1998,6 @@ let rec (desugar_data_pat : let uu___5 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.nil_lid - FStar_Syntax_Syntax.delta_constant (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor) in (uu___5, FStar_Pervasives_Native.None, []) in @@ -2057,7 +2015,6 @@ let rec (desugar_data_pat : let uu___4 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.cons_lid - FStar_Syntax_Syntax.delta_constant (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor) in (uu___4, FStar_Pervasives_Native.None, @@ -2149,7 +2106,6 @@ let rec (desugar_data_pat : FStar_Ident.lid_of_path ["__dummy__"] p1.FStar_Parser_AST.prange in FStar_Syntax_Syntax.lid_and_dd_as_fv lid - FStar_Syntax_Syntax.delta_constant (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Unresolved_constructor { @@ -2434,12 +2390,8 @@ and (desugar_machine_integer : FStar_Ident.path_of_text private_intro_nm in FStar_Ident.lid_of_path uu___3 range in let private_fv = - let uu___3 = - FStar_Syntax_Util.incr_delta_depth - (FStar_Pervasives_Native.__proj__Some__item__v - fv.FStar_Syntax_Syntax.fv_delta) in FStar_Syntax_Syntax.lid_and_dd_as_fv private_lid - uu___3 fv.FStar_Syntax_Syntax.fv_qual in + fv.FStar_Syntax_Syntax.fv_qual in { FStar_Syntax_Syntax.n = (FStar_Syntax_Syntax.Tm_fvar private_fv); @@ -2774,7 +2726,6 @@ and (desugar_term_maybe_top : FStar_Ident.set_lid_range FStar_Parser_Const.true_lid top.FStar_Parser_AST.range in FStar_Syntax_Syntax.fvar_with_dd uu___2 - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in (uu___1, noaqs) | FStar_Parser_AST.Name lid when @@ -2784,7 +2735,6 @@ and (desugar_term_maybe_top : FStar_Ident.set_lid_range FStar_Parser_Const.false_lid top.FStar_Parser_AST.range in FStar_Syntax_Syntax.fvar_with_dd uu___2 - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in (uu___1, noaqs) | FStar_Parser_AST.Projector (eff_name, id) when @@ -2800,8 +2750,7 @@ and (desugar_term_maybe_top : let lid = FStar_Syntax_Util.dm4f_lid ed txt in let uu___2 = FStar_Syntax_Syntax.fvar_with_dd lid - (FStar_Syntax_Syntax.Delta_constant_at_level - Prims.int_one) FStar_Pervasives_Native.None in + FStar_Pervasives_Native.None in (uu___2, noaqs) | FStar_Pervasives_Native.None -> let uu___2 = @@ -3303,7 +3252,6 @@ and (desugar_term_maybe_top : top.FStar_Parser_AST.range in FStar_Syntax_Syntax.lid_and_dd_as_fv uu___8 - FStar_Syntax_Syntax.delta_constant (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor) in let sc1 = @@ -3366,7 +3314,6 @@ and (desugar_term_maybe_top : top.FStar_Parser_AST.range in FStar_Syntax_Syntax.lid_and_dd_as_fv uu___9 - FStar_Syntax_Syntax.delta_constant (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor) in let sc1 = @@ -3730,8 +3677,7 @@ and (desugar_term_maybe_top : let uu___9 = let uu___10 = FStar_Ident.ident_of_lid l in FStar_Syntax_DsEnv.push_top_level_rec_binding - env1 uu___10 - FStar_Syntax_Syntax.delta_equational in + env1 uu___10 in (match uu___9 with | (env2, used_marker) -> (env2, (FStar_Pervasives.Inr l), @@ -3813,11 +3759,8 @@ and (desugar_term_maybe_top : FStar_Pervasives.Inl x | FStar_Pervasives.Inr l -> let uu___6 = - let uu___7 = - FStar_Syntax_Util.incr_delta_qualifier - body1 in FStar_Syntax_Syntax.lid_and_dd_as_fv l - uu___7 FStar_Pervasives_Native.None in + FStar_Pervasives_Native.None in FStar_Pervasives.Inr uu___6 in let body2 = if is_rec @@ -3957,11 +3900,8 @@ and (desugar_term_maybe_top : match uu___6 with | (body1, aq) -> let fv = - let uu___7 = - FStar_Syntax_Util.incr_delta_qualifier - t11 in FStar_Syntax_Syntax.lid_and_dd_as_fv l - uu___7 FStar_Pervasives_Native.None in + FStar_Pervasives_Native.None in let uu___7 = let uu___8 = let uu___9 = @@ -4094,9 +4034,7 @@ and (desugar_term_maybe_top : let uu___1 = let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv - FStar_Parser_Const.bool_lid - FStar_Syntax_Syntax.delta_constant - FStar_Pervasives_Native.None in + FStar_Parser_Const.bool_lid FStar_Pervasives_Native.None in FStar_Syntax_Syntax.Tm_fvar uu___2 in mk uu___1 in let uu___1 = desugar_term_aq env t1 in @@ -4326,7 +4264,6 @@ and (desugar_term_maybe_top : FStar_Ident.lid_of_path ["__dummy__"] top.FStar_Parser_AST.range in FStar_Syntax_Syntax.fvar_with_dd lid - FStar_Syntax_Syntax.delta_constant (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Unresolved_constructor uc)) in let mk_result args1 = @@ -4402,8 +4339,6 @@ and (desugar_term_maybe_top : match uu___2 with | FStar_Pervasives_Native.None -> FStar_Syntax_Syntax.fvar_with_dd f - (FStar_Syntax_Syntax.Delta_equational_at_level - Prims.int_one) (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Unresolved_projector FStar_Pervasives_Native.None)) @@ -4426,9 +4361,7 @@ and (desugar_term_maybe_top : let uu___3 = FStar_Ident.set_lid_range projname top.FStar_Parser_AST.range in - FStar_Syntax_Syntax.lid_and_dd_as_fv uu___3 - (FStar_Syntax_Syntax.Delta_equational_at_level - Prims.int_one) qual in + FStar_Syntax_Syntax.lid_and_dd_as_fv uu___3 qual in let qual1 = FStar_Syntax_Syntax.Unresolved_projector (FStar_Pervasives_Native.Some candidate_projector) in @@ -4436,8 +4369,6 @@ and (desugar_term_maybe_top : let uu___3 = qualify_field_names constrname [f] in FStar_Compiler_List.hd uu___3 in FStar_Syntax_Syntax.fvar_with_dd f1 - (FStar_Syntax_Syntax.Delta_equational_at_level - Prims.int_one) (FStar_Pervasives_Native.Some qual1) in let uu___2 = let uu___3 = @@ -4730,7 +4661,6 @@ and (desugar_term_maybe_top : let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.forall_intro_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___2 in let args = @@ -4774,7 +4704,6 @@ and (desugar_term_maybe_top : let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.exists_intro_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___2 in let args = @@ -4829,7 +4758,6 @@ and (desugar_term_maybe_top : let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.implies_intro_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___2 in let args = @@ -4861,7 +4789,6 @@ and (desugar_term_maybe_top : let head = let uu___1 = FStar_Syntax_Syntax.lid_and_dd_as_fv lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___1 in let args = @@ -4889,7 +4816,6 @@ and (desugar_term_maybe_top : let uu___1 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.and_intro_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___1 in let args = @@ -4924,7 +4850,6 @@ and (desugar_term_maybe_top : let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.forall_elim_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___2 in let args = @@ -5009,7 +4934,6 @@ and (desugar_term_maybe_top : let uu___3 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.exists_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___3 in let args = @@ -5037,7 +4961,6 @@ and (desugar_term_maybe_top : let uu___3 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.exists_elim_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___3 in let args = @@ -5136,7 +5059,6 @@ and (desugar_term_maybe_top : let uu___1 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.implies_elim_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___1 in let args = @@ -5186,7 +5108,6 @@ and (desugar_term_maybe_top : let uu___3 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.or_elim_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___3 in let extra_binder = @@ -5253,7 +5174,6 @@ and (desugar_term_maybe_top : let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.and_elim_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___2 in let args = @@ -5920,7 +5840,6 @@ and (desugar_comp : pat.FStar_Syntax_Syntax.pos in FStar_Syntax_Syntax.fvar_with_dd uu___10 - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in let uu___10 = let uu___11 = @@ -6130,7 +6049,6 @@ and (desugar_formula : let uu___1 = FStar_Ident.set_lid_range q b.FStar_Parser_AST.brange in FStar_Syntax_Syntax.fvar_with_dd uu___1 - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) FStar_Pervasives_Native.None in desugar_quant q_head b pats true body | FStar_Parser_AST.QExists (b::[], pats, body) -> @@ -6139,7 +6057,6 @@ and (desugar_formula : let uu___1 = FStar_Ident.set_lid_range q b.FStar_Parser_AST.brange in FStar_Syntax_Syntax.fvar_with_dd uu___1 - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) FStar_Pervasives_Native.None in desugar_quant q_head b pats true body | FStar_Parser_AST.QuantOp (i, b::[], pats, body) -> @@ -6508,14 +6425,11 @@ let (mk_indexed_projector_names : if only_decl then [decl] else - (let dd = - FStar_Syntax_Syntax.Delta_equational_at_level - Prims.int_one in - let lb = + (let lb = let uu___2 = let uu___3 = FStar_Syntax_Syntax.lid_and_dd_as_fv - field_name dd FStar_Pervasives_Native.None in + field_name FStar_Pervasives_Native.None in FStar_Pervasives.Inr uu___3 in { FStar_Syntax_Syntax.lbname = uu___2; @@ -6645,11 +6559,10 @@ let (mk_typ_abbrev : FStar_Syntax_DsEnv.lookup_letbinding_quals_and_attrs env lid in FStar_Pervasives_Native.snd uu___ in - let dd = FStar_Syntax_Util.incr_delta_qualifier t in let lb = let uu___ = let uu___1 = - FStar_Syntax_Syntax.lid_and_dd_as_fv lid dd + FStar_Syntax_Syntax.lid_and_dd_as_fv lid FStar_Pervasives_Native.None in FStar_Pervasives.Inr uu___1 in let uu___1 = @@ -7008,12 +6921,12 @@ let rec (desugar_tycon : } in let uu___2 = FStar_Syntax_DsEnv.push_top_level_rec_binding _env - id FStar_Syntax_Syntax.delta_constant in + id in (match uu___2 with | (_env1, uu___3) -> let uu___4 = FStar_Syntax_DsEnv.push_top_level_rec_binding - _env' id FStar_Syntax_Syntax.delta_constant in + _env' id in (match uu___4 with | (_env2, uu___5) -> (_env1, _env2, se, tconstr)))) | uu___1 -> FStar_Compiler_Effect.failwith "Unexpected tycon" in @@ -9303,7 +9216,6 @@ and (desugar_decl_core : let uu___5 = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.tcclass_lid - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in uu___5 :: (se.FStar_Syntax_Syntax.sigattrs) in FStar_Syntax_Util.deduplicate_terms uu___4 in @@ -9332,7 +9244,6 @@ and (desugar_decl_core : let uu___6 = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.tcclass_lid - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in uu___6 :: (se.FStar_Syntax_Syntax.sigattrs) in FStar_Syntax_Util.deduplicate_terms uu___5 in From 40516c1d49bdfdf3c361d1592ef4ee9ba7631a06 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 27 Apr 2024 11:37:23 -0700 Subject: [PATCH 124/239] base.Dockerfile: build base on Ubuntu 23.10 24.04 is broken right now and our CI is down --- .docker/base.Dockerfile | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.docker/base.Dockerfile b/.docker/base.Dockerfile index cad708d6404..9cd3aa7c576 100644 --- a/.docker/base.Dockerfile +++ b/.docker/base.Dockerfile @@ -9,7 +9,8 @@ # will NOT use this file. # We always try to build against the most current ubuntu image. -FROM ubuntu:latest +# FIXME: Broken with 24.04, fixing it to 23.10 so we can keep working +FROM ubuntu:23.10 RUN apt-get update From cfb3d61bc8bf344854508d5448d19d10b10d552f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 26 Apr 2024 22:28:09 -0700 Subject: [PATCH 125/239] base.Dockerfile: remove libicu from install invocation It seems to flow into the dependencies automatically. Plus, this now broke after the version in the Ubuntu repos became 74 instead of 70. --- .docker/base.Dockerfile | 2 -- 1 file changed, 2 deletions(-) diff --git a/.docker/base.Dockerfile b/.docker/base.Dockerfile index 9cd3aa7c576..1f8c7dea910 100644 --- a/.docker/base.Dockerfile +++ b/.docker/base.Dockerfile @@ -23,7 +23,6 @@ RUN apt-get -y --no-install-recommends install vim emacs # Base dependencies: opam # CI dependencies: jq (to identify F* branch) # python3 (for interactive tests) -# libicu (for .NET, cf. https://aka.ms/dotnet-missing-libicu ) RUN apt-get install -y --no-install-recommends \ jq \ bc \ @@ -35,7 +34,6 @@ RUN apt-get install -y --no-install-recommends \ sudo \ python3 \ python-is-python3 \ - libicu70 \ opam \ && apt-get clean -y From 18b55b2a52b20e3cea968e8ce79e3f7b4609be8a Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Sun, 28 Apr 2024 13:09:27 -0700 Subject: [PATCH 126/239] rlimit bump & retry on Lib.Vec.Lemmas --- tests/hacl/Lib.Vec.Lemmas.fst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/hacl/Lib.Vec.Lemmas.fst b/tests/hacl/Lib.Vec.Lemmas.fst index bde6bd5a505..2e458cae49c 100644 --- a/tests/hacl/Lib.Vec.Lemmas.fst +++ b/tests/hacl/Lib.Vec.Lemmas.fst @@ -202,7 +202,7 @@ let repeat_gen_blocks_multi_vec_step #inp_t w blocksize n hi_f inp a a_vec f f_v assert (repeat_gen_blocks_multi_vec_equiv_pre w blocksize n hi_f a a_vec f f_v normalize_v i b_v acc_v) -#push-options "--z3rlimit_factor 12" +#push-options "--z3rlimit_factor 16 --retry 2" let lemma_repeat_gen_blocks_multi_vec #inp_t w blocksize n hi_f inp a a_vec f f_v normalize_v acc_v0 = let len = length inp in let blocksize_v = w * blocksize in From 614db05f584ebc2c46364a1725fa2898ab82477c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 28 Apr 2024 19:26:50 -0700 Subject: [PATCH 127/239] Tc.Quals: tidy --- src/typechecker/FStar.TypeChecker.Quals.fst | 79 +++++++++------------ 1 file changed, 32 insertions(+), 47 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.Quals.fst b/src/typechecker/FStar.TypeChecker.Quals.fst index a7fca344a8e..d95a41d712d 100644 --- a/src/typechecker/FStar.TypeChecker.Quals.fst +++ b/src/typechecker/FStar.TypeChecker.Quals.fst @@ -230,54 +230,39 @@ let check_erasable env quals r se = * if and only if `e` is a type that's non-informative (e..g., unit, t -> unit, etc.) *) let check_must_erase_attribute env se = - match se.sigel with - | Sig_let {lbs; lids=l} -> - if not (Options.ide()) - then - begin - match DsEnv.iface_decls (Env.dsenv env) (Env.current_module env) with - | None -> - () - - | Some iface_decls -> - snd lbs |> List.iter (fun lb -> - let lbname = BU.right lb.lbname in - let has_iface_val = - iface_decls |> BU.for_some (FStar.Parser.AST.decl_is_val (ident_of_lid lbname.fv_name.v)) - in - if has_iface_val - then - let must_erase = - TcUtil.must_erase_for_extraction env lb.lbdef in - let has_attr = - Env.fv_has_attr env - lbname - FStar.Parser.Const.must_erase_for_extraction_attr in - if must_erase && not has_attr - then - FStar.Errors.log_issue_doc - (range_of_fv lbname) - (FStar.Errors.Error_MustEraseMissing, - [Errors.text (BU.format2 - "Values of type `%s` will be erased during extraction, \ - but its interface hides this fact. Add the `must_erase_for_extraction` \ - attribute to the `val %s` declaration for this symbol in the interface" - (Print.fv_to_string lbname) - (Print.fv_to_string lbname) - )]) - else if has_attr && not must_erase - then FStar.Errors.log_issue_doc - (range_of_fv lbname) - (FStar.Errors.Error_MustEraseMissing, - [Errors.text (BU.format1 - "Values of type `%s` cannot be erased during extraction, \ - but the `must_erase_for_extraction` attribute claims that it can. \ - Please remove the attribute." - (Print.fv_to_string lbname) - )])) - end + if Options.ide() then () else + match se.sigel with + | Sig_let {lbs; lids=l} -> + begin match DsEnv.iface_decls (Env.dsenv env) (Env.current_module env) with + | None -> + () - | _ -> () + | Some iface_decls -> + snd lbs |> List.iter (fun lb -> + let lbname = BU.right lb.lbname in + let has_iface_val = + iface_decls |> BU.for_some (Parser.AST.decl_is_val (ident_of_lid lbname.fv_name.v)) + in + if has_iface_val + then + let must_erase = TcUtil.must_erase_for_extraction env lb.lbdef in + let has_attr = Env.fv_has_attr env lbname C.must_erase_for_extraction_attr in + if must_erase && not has_attr + then log_issue_doc (range_of_fv lbname) (Error_MustEraseMissing, [ + text (BU.format2 "Values of type `%s` will be erased during extraction, \ + but its interface hides this fact. Add the `must_erase_for_extraction` \ + attribute to the `val %s` declaration for this symbol in the interface" + (show lbname) (show lbname)); + ]) + else if has_attr && not must_erase + then log_issue_doc (range_of_fv lbname) (Error_MustEraseMissing, [ + text (BU.format1 "Values of type `%s` cannot be erased during extraction, \ + but the `must_erase_for_extraction` attribute claims that it can. \ + Please remove the attribute." + (show lbname)); + ])) + end + | _ -> () let check_typeclass_instance_attribute env rng se = let is_tc_instance = From cdb7b826bf3f5253fa94f689391f175039918bf1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 28 Apr 2024 19:37:38 -0700 Subject: [PATCH 128/239] tests/hacl: rlimit and hints --- tests/hacl/Lib.IntTypes.fsti.hints | 1025 ++++++++ tests/hacl/Lib.LoopCombinators.fst.hints | 1299 ++++++++++ tests/hacl/Lib.LoopCombinators.fsti.hints | 383 +++ tests/hacl/Lib.Sequence.Lemmas.fst | 4 +- tests/hacl/Lib.Sequence.Lemmas.fst.hints | 2818 +++++++++++++++++++++ tests/hacl/Lib.Sequence.Lemmas.fsti.hints | 860 +++++++ tests/hacl/Lib.Sequence.fsti.hints | 976 +++++++ tests/hacl/Lib.Vec.Lemmas.fst.hints | 2294 +++++++++++++++++ tests/hacl/Lib.Vec.Lemmas.fsti.hints | 403 +++ 9 files changed, 10060 insertions(+), 2 deletions(-) create mode 100644 tests/hacl/Lib.IntTypes.fsti.hints create mode 100644 tests/hacl/Lib.LoopCombinators.fst.hints create mode 100644 tests/hacl/Lib.LoopCombinators.fsti.hints create mode 100644 tests/hacl/Lib.Sequence.Lemmas.fst.hints create mode 100644 tests/hacl/Lib.Sequence.Lemmas.fsti.hints create mode 100644 tests/hacl/Lib.Sequence.fsti.hints create mode 100644 tests/hacl/Lib.Vec.Lemmas.fst.hints create mode 100644 tests/hacl/Lib.Vec.Lemmas.fsti.hints diff --git a/tests/hacl/Lib.IntTypes.fsti.hints b/tests/hacl/Lib.IntTypes.fsti.hints new file mode 100644 index 00000000000..132cbccf421 --- /dev/null +++ b/tests/hacl/Lib.IntTypes.fsti.hints @@ -0,0 +1,1025 @@ +[ + "æ\t×\u000bÔ\u001e©\u001e×4†hÛÖ?Á", + [ + [ + "Lib.IntTypes.numbytes", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "disc_equation_Lib.IntTypes.S128", + "disc_equation_Lib.IntTypes.S16", "disc_equation_Lib.IntTypes.S32", + "disc_equation_Lib.IntTypes.S64", "disc_equation_Lib.IntTypes.S8", + "disc_equation_Lib.IntTypes.U1", "disc_equation_Lib.IntTypes.U128", + "disc_equation_Lib.IntTypes.U16", "disc_equation_Lib.IntTypes.U32", + "disc_equation_Lib.IntTypes.U64", "disc_equation_Lib.IntTypes.U8", + "fuel_guarded_inversion_Lib.IntTypes.inttype", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "9e2bb78b55b4b0e15a54a3e4d392bea8" + ], + [ + "Lib.IntTypes.bits", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "disc_equation_Lib.IntTypes.S128", + "disc_equation_Lib.IntTypes.S16", "disc_equation_Lib.IntTypes.S32", + "disc_equation_Lib.IntTypes.S64", "disc_equation_Lib.IntTypes.S8", + "disc_equation_Lib.IntTypes.U1", "disc_equation_Lib.IntTypes.U128", + "disc_equation_Lib.IntTypes.U16", "disc_equation_Lib.IntTypes.U32", + "disc_equation_Lib.IntTypes.U64", "disc_equation_Lib.IntTypes.U8", + "fuel_guarded_inversion_Lib.IntTypes.inttype", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "6df491e6cfab2c5858d32707ba9ebcb9" + ], + [ + "Lib.IntTypes.modulus", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.IntTypes.bits", + "fuel_guarded_inversion_Lib.IntTypes.inttype", + "projection_inverse_BoxInt_proj_0" + ], + 0, + "e8a504abdad1eb956688b98193cb8496" + ], + [ + "Lib.IntTypes.maxint", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.unsigned", + "fuel_guarded_inversion_Lib.IntTypes.inttype", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0" + ], + 0, + "e8ab8ee743cd8a9d5f2d78cb9d230f9b" + ], + [ + "Lib.IntTypes.minint", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.unsigned", + "fuel_guarded_inversion_Lib.IntTypes.inttype", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0" + ], + 0, + "88bf422951a779c19b61bd1c30c4667d" + ], + [ + "Lib.IntTypes.pub_int_t", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "disc_equation_Lib.IntTypes.S128", + "disc_equation_Lib.IntTypes.S16", "disc_equation_Lib.IntTypes.S32", + "disc_equation_Lib.IntTypes.S64", "disc_equation_Lib.IntTypes.S8", + "disc_equation_Lib.IntTypes.U1", "disc_equation_Lib.IntTypes.U128", + "disc_equation_Lib.IntTypes.U16", "disc_equation_Lib.IntTypes.U32", + "disc_equation_Lib.IntTypes.U64", "disc_equation_Lib.IntTypes.U8", + "fuel_guarded_inversion_Lib.IntTypes.inttype", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "d001b186588ce165afd6d544abd75b89" + ], + [ + "Lib.IntTypes.pub_int_v", + 1, + 0, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "b2t_def", "bool_inversion", + "constructor_distinct_Lib.IntTypes.S128", + "constructor_distinct_Lib.IntTypes.S16", + "constructor_distinct_Lib.IntTypes.S32", + "constructor_distinct_Lib.IntTypes.S64", + "constructor_distinct_Lib.IntTypes.S8", + "constructor_distinct_Lib.IntTypes.U1", + "constructor_distinct_Lib.IntTypes.U128", + "constructor_distinct_Lib.IntTypes.U16", + "constructor_distinct_Lib.IntTypes.U32", + "constructor_distinct_Lib.IntTypes.U64", + "constructor_distinct_Lib.IntTypes.U8", + "disc_equation_Lib.IntTypes.S128", "disc_equation_Lib.IntTypes.S16", + "disc_equation_Lib.IntTypes.S32", "disc_equation_Lib.IntTypes.S64", + "disc_equation_Lib.IntTypes.S8", "disc_equation_Lib.IntTypes.U1", + "disc_equation_Lib.IntTypes.U128", "disc_equation_Lib.IntTypes.U16", + "disc_equation_Lib.IntTypes.U32", "disc_equation_Lib.IntTypes.U64", + "disc_equation_Lib.IntTypes.U8", "equality_tok_Lib.IntTypes.S16@tok", + "equality_tok_Lib.IntTypes.S32@tok", + "equality_tok_Lib.IntTypes.S64@tok", + "equality_tok_Lib.IntTypes.S8@tok", + "equality_tok_Lib.IntTypes.U128@tok", + "equality_tok_Lib.IntTypes.U16@tok", + "equality_tok_Lib.IntTypes.U1@tok", + "equality_tok_Lib.IntTypes.U32@tok", + "equality_tok_Lib.IntTypes.U64@tok", + "equality_tok_Lib.IntTypes.U8@tok", "equation_FStar.Int.fits", + "equation_FStar.Int.max_int", "equation_FStar.Int.min_int", + "equation_FStar.Int.size", "equation_FStar.UInt.fits", + "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.size", "equation_FStar.UInt128.n", + "equation_Lib.IntTypes.bits", "equation_Lib.IntTypes.maxint", + "equation_Lib.IntTypes.minint", "equation_Lib.IntTypes.pub_int_t", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "equation_Prims.nat", "fuel_guarded_inversion_Lib.IntTypes.inttype", + "lemma_FStar.UInt.pow2_values", "primitive_Prims.op_AmpAmp", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Minus", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_e0b16d74ee3644bd585df5e7938934c6", + "typing_Lib.IntTypes.bits", "typing_Lib.IntTypes.uu___is_U1", + "typing_tok_Lib.IntTypes.U1@tok" + ], + 0, + "40343825a8f06b7c97658cd35f7375e2" + ], + [ + "Lib.IntTypes.int_t", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "disc_equation_Lib.IntTypes.PUB", + "disc_equation_Lib.IntTypes.SEC", + "fuel_guarded_inversion_Lib.IntTypes.secrecy_level", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "e2fac751a7003aed037df9676f4dde08" + ], + [ + "Lib.IntTypes.v", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "constructor_distinct_Lib.IntTypes.PUB", + "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.PUB", "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.PUB@tok", + "equality_tok_Lib.IntTypes.SEC@tok", "equation_Lib.IntTypes.int_t", + "fuel_guarded_inversion_Lib.IntTypes.secrecy_level", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "860dd2f9ac85a3e79e5b2748bb78890e" + ], + [ + "Lib.IntTypes.u128", + 1, + 0, + 1, + [ "@query" ], + 0, + "f491d27970b48a4ccd7d475d51aee3b5" + ], + [ + "Lib.IntTypes.i128", + 1, + 0, + 1, + [ "@query" ], + 0, + "61ff775dde8a4e2a1d0e70d15c931562" + ], + [ + "Lib.IntTypes.size", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.S16", + "constructor_distinct_Lib.IntTypes.U32", + "equality_tok_Lib.IntTypes.U32@tok", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0" + ], + 0, + "82c5c162c6ddf6096fbc9029f3875380" + ], + [ + "Lib.IntTypes.byte", + 1, + 0, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "constructor_distinct_Lib.IntTypes.U8", + "equality_tok_Lib.IntTypes.U8@tok", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "equation_Prims.nat", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_31c7d3d85d92cb942c95a78642e657c7", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "typing_Lib.IntTypes.bits", "typing_tok_Lib.IntTypes.U8@tok" + ], + 0, + "98d3556120d6c3c0581c038ec9958d9f" + ], + [ + "Lib.IntTypes.byte_v", + 1, + 0, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "constructor_distinct_Lib.IntTypes.U8", + "equality_tok_Lib.IntTypes.U8@tok", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "typing_Lib.IntTypes.bits", "typing_tok_Lib.IntTypes.U8@tok" + ], + 0, + "cf36da756927afd2d372d1619820a23c" + ], + [ + "Lib.IntTypes.size_to_uint64", + 1, + 0, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "constructor_distinct_Lib.IntTypes.S16", + "constructor_distinct_Lib.IntTypes.S32", + "constructor_distinct_Lib.IntTypes.S8", + "constructor_distinct_Lib.IntTypes.U32", + "constructor_distinct_Lib.IntTypes.U64", + "equality_tok_Lib.IntTypes.U32@tok", + "equality_tok_Lib.IntTypes.U64@tok", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "equation_Prims.nat", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "typing_Lib.IntTypes.bits", "typing_tok_Lib.IntTypes.U32@tok", + "typing_tok_Lib.IntTypes.U64@tok" + ], + 0, + "0224ed5192a3418a1b1ceeeab5f8cdf0" + ], + [ + "Lib.IntTypes.op_At_Percent_Dot", + 1, + 0, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.IntTypes.bits", "equation_Lib.IntTypes.unsigned", + "equation_Prims.nat", "fuel_guarded_inversion_Lib.IntTypes.inttype", + "lemma_FStar.UInt.pow2_values", "primitive_Prims.op_Modulus", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "typing_Lib.IntTypes.bits" + ], + 0, + "c903cc7da03ad95b2caab1c932864e16" + ], + [ + "Lib.IntTypes.to_u1", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "1553c1686d9988a0f5cc5cc835fd30e5" + ], + [ + "Lib.IntTypes.to_u8", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "9549f3221d11d3d80962f4496073b213" + ], + [ + "Lib.IntTypes.to_i8", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "55898475b0849a89802b46ed5d656517" + ], + [ + "Lib.IntTypes.to_u16", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "732dac3cb985659db3de16c8adab37f6" + ], + [ + "Lib.IntTypes.to_i16", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "1ce730547ce52b9e3a6ebeddec37cfd7" + ], + [ + "Lib.IntTypes.to_u32", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "c18a0a9ae5fca7f7fd027557c558a5d0" + ], + [ + "Lib.IntTypes.to_i32", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "9344e260f609709bcd60b84330eaf85d" + ], + [ + "Lib.IntTypes.to_u64", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "8f87fe672e152c8a2e8190c871746c54" + ], + [ + "Lib.IntTypes.to_i64", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "b26beb50016c1ee30282b45e79fdf04b" + ], + [ + "Lib.IntTypes.to_u128", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "d6ae0f3520caa59f5f7c4fa90ebc1bbf" + ], + [ + "Lib.IntTypes.to_i128", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "b01548ac72990c385be89b1cf8d589e0" + ], + [ + "Lib.IntTypes.ones_v", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "disc_equation_Lib.IntTypes.S128", + "disc_equation_Lib.IntTypes.S16", "disc_equation_Lib.IntTypes.S32", + "disc_equation_Lib.IntTypes.S64", "disc_equation_Lib.IntTypes.S8", + "disc_equation_Lib.IntTypes.U1", "disc_equation_Lib.IntTypes.U128", + "disc_equation_Lib.IntTypes.U16", "disc_equation_Lib.IntTypes.U32", + "disc_equation_Lib.IntTypes.U64", "disc_equation_Lib.IntTypes.U8", + "fuel_guarded_inversion_Lib.IntTypes.inttype", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "bb2d3fc6ccf843e96b4945a7266fbf59" + ], + [ + "Lib.IntTypes.logxor_lemma", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "constructor_distinct_Lib.IntTypes.S128", + "constructor_distinct_Lib.IntTypes.S16", + "constructor_distinct_Lib.IntTypes.S32", + "constructor_distinct_Lib.IntTypes.S64", + "constructor_distinct_Lib.IntTypes.S8", + "constructor_distinct_Lib.IntTypes.U1", + "constructor_distinct_Lib.IntTypes.U128", + "constructor_distinct_Lib.IntTypes.U16", + "constructor_distinct_Lib.IntTypes.U32", + "constructor_distinct_Lib.IntTypes.U64", + "constructor_distinct_Lib.IntTypes.U8", + "equality_tok_Lib.IntTypes.U128@tok", + "equality_tok_Lib.IntTypes.U16@tok", + "equality_tok_Lib.IntTypes.U1@tok", + "equality_tok_Lib.IntTypes.U32@tok", + "equality_tok_Lib.IntTypes.U64@tok", + "equality_tok_Lib.IntTypes.U8@tok", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "equation_Prims.nat", "equation_Prims.pos", + "fuel_guarded_inversion_Lib.IntTypes.inttype", "int_typing", + "primitive_Prims.op_Minus", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "typing_Lib.IntTypes.bits", "typing_Prims.pow2", + "typing_tok_Lib.IntTypes.U128@tok", + "typing_tok_Lib.IntTypes.U16@tok", "typing_tok_Lib.IntTypes.U1@tok", + "typing_tok_Lib.IntTypes.U32@tok", "typing_tok_Lib.IntTypes.U64@tok", + "typing_tok_Lib.IntTypes.U8@tok" + ], + 0, + "0c99ed54fd557104f2de6280aa0fab68" + ], + [ + "Lib.IntTypes.logxor_v", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", "bool_inversion", + "constructor_distinct_Lib.IntTypes.S128", + "constructor_distinct_Lib.IntTypes.S16", + "constructor_distinct_Lib.IntTypes.S32", + "constructor_distinct_Lib.IntTypes.S64", + "constructor_distinct_Lib.IntTypes.S8", + "constructor_distinct_Lib.IntTypes.U1", + "constructor_distinct_Lib.IntTypes.U128", + "constructor_distinct_Lib.IntTypes.U16", + "constructor_distinct_Lib.IntTypes.U32", + "constructor_distinct_Lib.IntTypes.U64", + "constructor_distinct_Lib.IntTypes.U8", + "disc_equation_Lib.IntTypes.S128", "disc_equation_Lib.IntTypes.S16", + "disc_equation_Lib.IntTypes.S32", "disc_equation_Lib.IntTypes.S64", + "disc_equation_Lib.IntTypes.S8", + "equality_tok_Lib.IntTypes.S128@tok", + "equality_tok_Lib.IntTypes.S16@tok", + "equality_tok_Lib.IntTypes.S32@tok", + "equality_tok_Lib.IntTypes.S64@tok", + "equality_tok_Lib.IntTypes.S8@tok", "equation_FStar.Int.fits", + "equation_FStar.Int.max_int", "equation_FStar.Int.min_int", + "equation_FStar.Int.size", "equation_FStar.UInt.fits", + "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.size", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "fuel_guarded_inversion_Lib.IntTypes.inttype", "int_inversion", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_83845a86f2550cdf941eeb1d9b59602b", + "typing_FStar.Int.fits", "typing_Lib.IntTypes.uu___is_S8" + ], + 0, + "616cf8141c2ea4c0aac70a3227e079f9" + ], + [ + "Lib.IntTypes.logand_v", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", "bool_inversion", + "constructor_distinct_Lib.IntTypes.S128", + "constructor_distinct_Lib.IntTypes.S16", + "constructor_distinct_Lib.IntTypes.S32", + "constructor_distinct_Lib.IntTypes.S64", + "constructor_distinct_Lib.IntTypes.S8", + "constructor_distinct_Lib.IntTypes.U1", + "constructor_distinct_Lib.IntTypes.U128", + "constructor_distinct_Lib.IntTypes.U16", + "constructor_distinct_Lib.IntTypes.U32", + "constructor_distinct_Lib.IntTypes.U64", + "constructor_distinct_Lib.IntTypes.U8", + "disc_equation_Lib.IntTypes.S128", "disc_equation_Lib.IntTypes.S16", + "disc_equation_Lib.IntTypes.S32", "disc_equation_Lib.IntTypes.S64", + "disc_equation_Lib.IntTypes.S8", + "equality_tok_Lib.IntTypes.S128@tok", + "equality_tok_Lib.IntTypes.S16@tok", + "equality_tok_Lib.IntTypes.S32@tok", + "equality_tok_Lib.IntTypes.S64@tok", + "equality_tok_Lib.IntTypes.S8@tok", "equation_FStar.Int.fits", + "equation_FStar.Int.max_int", "equation_FStar.Int.min_int", + "equation_FStar.Int.size", "equation_FStar.UInt.fits", + "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.size", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "fuel_guarded_inversion_Lib.IntTypes.inttype", "int_inversion", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_83845a86f2550cdf941eeb1d9b59602b", + "typing_FStar.Int.fits", "typing_Lib.IntTypes.uu___is_S8" + ], + 0, + "f18a7229a159756737ae0b412d407790" + ], + [ + "Lib.IntTypes.logand_mask", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_812109ba662576a3f745174092d33c56" + ], + 0, + "10c64f04d1adbe5a223536ecc98f7286" + ], + [ + "Lib.IntTypes.logor_disjoint", + 1, + 0, + 1, + [ "@query" ], + 0, + "93cbcff1a894107f89f92acff3e68e5f" + ], + [ + "Lib.IntTypes.logor_v", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", "bool_inversion", + "constructor_distinct_Lib.IntTypes.S128", + "constructor_distinct_Lib.IntTypes.S16", + "constructor_distinct_Lib.IntTypes.S32", + "constructor_distinct_Lib.IntTypes.S64", + "constructor_distinct_Lib.IntTypes.S8", + "constructor_distinct_Lib.IntTypes.U1", + "constructor_distinct_Lib.IntTypes.U128", + "constructor_distinct_Lib.IntTypes.U16", + "constructor_distinct_Lib.IntTypes.U32", + "constructor_distinct_Lib.IntTypes.U64", + "constructor_distinct_Lib.IntTypes.U8", + "disc_equation_Lib.IntTypes.S128", "disc_equation_Lib.IntTypes.S16", + "disc_equation_Lib.IntTypes.S32", "disc_equation_Lib.IntTypes.S64", + "disc_equation_Lib.IntTypes.S8", + "equality_tok_Lib.IntTypes.S128@tok", + "equality_tok_Lib.IntTypes.S16@tok", + "equality_tok_Lib.IntTypes.S32@tok", + "equality_tok_Lib.IntTypes.S64@tok", + "equality_tok_Lib.IntTypes.S8@tok", "equation_FStar.Int.fits", + "equation_FStar.Int.max_int", "equation_FStar.Int.min_int", + "equation_FStar.Int.size", "equation_FStar.UInt.fits", + "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.size", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "fuel_guarded_inversion_Lib.IntTypes.inttype", "int_inversion", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_83845a86f2550cdf941eeb1d9b59602b", + "typing_FStar.Int.fits", "typing_Lib.IntTypes.uu___is_S8" + ], + 0, + "aab274c7be7bafd774e8e950eeb2e6d1" + ], + [ + "Lib.IntTypes.lognot_v", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", "bool_inversion", + "constructor_distinct_Lib.IntTypes.S128", + "constructor_distinct_Lib.IntTypes.S16", + "constructor_distinct_Lib.IntTypes.S32", + "constructor_distinct_Lib.IntTypes.S64", + "constructor_distinct_Lib.IntTypes.S8", + "constructor_distinct_Lib.IntTypes.U1", + "constructor_distinct_Lib.IntTypes.U128", + "constructor_distinct_Lib.IntTypes.U16", + "constructor_distinct_Lib.IntTypes.U32", + "constructor_distinct_Lib.IntTypes.U64", + "constructor_distinct_Lib.IntTypes.U8", + "disc_equation_Lib.IntTypes.S128", "disc_equation_Lib.IntTypes.S16", + "disc_equation_Lib.IntTypes.S32", "disc_equation_Lib.IntTypes.S64", + "disc_equation_Lib.IntTypes.S8", + "equality_tok_Lib.IntTypes.S128@tok", + "equality_tok_Lib.IntTypes.S16@tok", + "equality_tok_Lib.IntTypes.S32@tok", + "equality_tok_Lib.IntTypes.S64@tok", + "equality_tok_Lib.IntTypes.S8@tok", "equation_FStar.Int.fits", + "equation_FStar.Int.max_int", "equation_FStar.Int.min_int", + "equation_FStar.Int.size", "equation_FStar.UInt.fits", + "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.size", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "fuel_guarded_inversion_Lib.IntTypes.inttype", "int_inversion", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_83845a86f2550cdf941eeb1d9b59602b", + "typing_Lib.IntTypes.uu___is_S8" + ], + 0, + "d0d652b85995f937275b0edbc1d07918" + ], + [ + "Lib.IntTypes.shift_right_lemma", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "constructor_distinct_Lib.IntTypes.U32", + "equality_tok_Lib.IntTypes.PUB@tok", + "equality_tok_Lib.IntTypes.U32@tok", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.shiftval", + "equation_Lib.IntTypes.unsigned", "equation_Lib.IntTypes.v", + "refinement_interpretation_Tm_refine_83845a86f2550cdf941eeb1d9b59602b", + "refinement_interpretation_Tm_refine_e40dba697735a60216c598c2a27841b5", + "typing_Lib.IntTypes.v", "typing_tok_Lib.IntTypes.PUB@tok", + "typing_tok_Lib.IntTypes.U32@tok" + ], + 0, + "4173c45fd3a237d93bdbdd7d5c99ac51" + ], + [ + "Lib.IntTypes.shift_left", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "constructor_distinct_Lib.IntTypes.U32", + "equality_tok_Lib.IntTypes.PUB@tok", + "equality_tok_Lib.IntTypes.U32@tok", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.shiftval", + "equation_Lib.IntTypes.unsigned", "equation_Lib.IntTypes.v", + "refinement_interpretation_Tm_refine_83845a86f2550cdf941eeb1d9b59602b", + "refinement_interpretation_Tm_refine_e40dba697735a60216c598c2a27841b5", + "typing_Lib.IntTypes.v", "typing_tok_Lib.IntTypes.PUB@tok", + "typing_tok_Lib.IntTypes.U32@tok" + ], + 0, + "8665ba9e4b62458a4b07e5e7e9beeb0b" + ], + [ + "Lib.IntTypes.shift_left_lemma", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "constructor_distinct_Lib.IntTypes.U32", + "equality_tok_Lib.IntTypes.PUB@tok", + "equality_tok_Lib.IntTypes.U32@tok", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.shiftval", + "equation_Lib.IntTypes.unsigned", "equation_Lib.IntTypes.v", + "refinement_interpretation_Tm_refine_4d1a190ec02a669657768f0db44948f9", + "refinement_interpretation_Tm_refine_83845a86f2550cdf941eeb1d9b59602b", + "refinement_interpretation_Tm_refine_e40dba697735a60216c598c2a27841b5", + "typing_Lib.IntTypes.v", "typing_tok_Lib.IntTypes.PUB@tok", + "typing_tok_Lib.IntTypes.U32@tok" + ], + 0, + "3386dd253c981077f1af8223ac54a057" + ], + [ + "Lib.IntTypes.shift_right_i", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_33026181614126bf2f989b87912ad69b" + ], + 0, + "5fbfd5f677fe23266d59d11513e5fb89" + ], + [ + "Lib.IntTypes.shift_right_i", + 2, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_33026181614126bf2f989b87912ad69b" + ], + 0, + "55d85badc03b89489c58b3478d6293cb" + ], + [ + "Lib.IntTypes.shift_left_i", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_33026181614126bf2f989b87912ad69b" + ], + 0, + "c4614a27c8d77ccfad1be044e40f0f12" + ], + [ + "Lib.IntTypes.shift_left_i", + 2, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_33026181614126bf2f989b87912ad69b" + ], + 0, + "4c7db43cfdec5e9a4f0c84f2f7d72f13" + ], + [ + "Lib.IntTypes.rotate_right_i", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_fe1f2b0fb92318a15c076125042e53a3" + ], + 0, + "7f7b8483bb7a087b012dcb242b05f08d" + ], + [ + "Lib.IntTypes.rotate_right_i", + 2, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_fe1f2b0fb92318a15c076125042e53a3" + ], + 0, + "28f89a774ababe46c89e64c01327da72" + ], + [ + "Lib.IntTypes.rotate_left_i", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_fe1f2b0fb92318a15c076125042e53a3" + ], + 0, + "d1dc071b4b951717c443bd99ab0a2fca" + ], + [ + "Lib.IntTypes.rotate_left_i", + 2, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_fe1f2b0fb92318a15c076125042e53a3" + ], + 0, + "c46dca3e175d725448688c03445d5ecf" + ], + [ + "Lib.IntTypes.mod_mask", + 1, + 1, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", + "@fuel_irrelevance_Prims.pow2.fuel_instrumented", "@query", + "constructor_distinct_Lib.IntTypes.U32", + "equality_tok_Lib.IntTypes.PUB@tok", + "equality_tok_Lib.IntTypes.U32@tok", + "equation_FStar.Int.op_At_Percent", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.op_At_Percent_Dot", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.shiftval", + "equation_Lib.IntTypes.unsigned", "equation_Lib.IntTypes.v", + "equation_Prims.abs", "equation_Prims.nat", "equation_Prims.pos", + "equation_with_fuel_Prims.pow2.fuel_instrumented", + "fuel_guarded_inversion_Lib.IntTypes.inttype", "int_inversion", + "int_typing", "lemma_FStar.Int.pow2_values", + "lemma_FStar.UInt.pow2_values", "lemma_Lib.IntTypes.pow2_127", + "lemma_Lib.IntTypes.pow2_2", "lemma_Lib.IntTypes.pow2_3", + "lemma_Lib.IntTypes.pow2_4", "primitive_Prims.op_GreaterThanOrEqual", + "primitive_Prims.op_Minus", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_83845a86f2550cdf941eeb1d9b59602b", + "refinement_interpretation_Tm_refine_ac5393c1a5eb4d36f425e5e42929859b", + "refinement_interpretation_Tm_refine_b6806f707b80b45deafff2826c0c9018", + "refinement_interpretation_Tm_refine_e40dba697735a60216c598c2a27841b5", + "typing_Lib.IntTypes.bits", "typing_Lib.IntTypes.v", + "typing_Prims.pow2", "typing_tok_Lib.IntTypes.PUB@tok", + "typing_tok_Lib.IntTypes.U32@tok" + ], + 0, + "1f621f0bea518f6fccc3023e46677200" + ], + [ + "Lib.IntTypes.mod_mask", + 2, + 1, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.U32", + "equality_tok_Lib.IntTypes.U32@tok", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned" + ], + 0, + "1f7a8e0f9882d3262be6e777cfe35e35" + ], + [ + "Lib.IntTypes.mod_mask_lemma", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", + "constructor_distinct_Lib.IntTypes.PUB", + "constructor_distinct_Lib.IntTypes.U32", + "equality_tok_Lib.IntTypes.PUB@tok", + "equality_tok_Lib.IntTypes.U32@tok", "equation_FStar.UInt.fits", + "equation_FStar.UInt.min_int", "equation_FStar.UInt.size", + "equation_FStar.UInt.uint_t", "equation_Lib.IntTypes.int_t", + "equation_Lib.IntTypes.minint", "equation_Lib.IntTypes.pub_int_t", + "equation_Lib.IntTypes.pub_int_v", "equation_Lib.IntTypes.range", + "equation_Lib.IntTypes.shiftval", "equation_Lib.IntTypes.unsigned", + "equation_Lib.IntTypes.v", "primitive_Prims.op_AmpAmp", + "primitive_Prims.op_LessThanOrEqual", + "projection_inverse_BoxBool_proj_0", + "refinement_interpretation_Tm_refine_ac5393c1a5eb4d36f425e5e42929859b", + "refinement_interpretation_Tm_refine_e40dba697735a60216c598c2a27841b5", + "refinement_interpretation_Tm_refine_f13070840248fced9d9d60d77bdae3ec", + "typing_FStar.UInt32.v" + ], + 0, + "ff29dc6dbd3bd114671da7c8a2a61a9a" + ], + [ + "Lib.IntTypes.div", + 1, + 0, + 1, + [ "@query" ], + 0, + "7ac2f9a08e83e0f729fd11b54e6e6d4e" + ], + [ + "Lib.IntTypes.div_lemma", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_e450d0eda8ec6ce5c9eff42d01f0e81a" + ], + 0, + "5073732f269af350b22e9a0fc3d58023" + ], + [ + "Lib.IntTypes.mod", + 1, + 0, + 1, + [ "@query" ], + 0, + "395e988323e6f01258fbfa166b5077a2" + ], + [ + "Lib.IntTypes.mod_lemma", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", "bool_inversion", + "constructor_distinct_Lib.IntTypes.PUB", + "constructor_distinct_Lib.IntTypes.S16", + "constructor_distinct_Lib.IntTypes.S32", + "constructor_distinct_Lib.IntTypes.S64", + "constructor_distinct_Lib.IntTypes.S8", + "constructor_distinct_Lib.IntTypes.U1", + "constructor_distinct_Lib.IntTypes.U16", + "constructor_distinct_Lib.IntTypes.U32", + "constructor_distinct_Lib.IntTypes.U64", + "constructor_distinct_Lib.IntTypes.U8", + "disc_equation_Lib.IntTypes.S128", "disc_equation_Lib.IntTypes.U128", + "equality_tok_Lib.IntTypes.PUB@tok", "equation_FStar.Int.int_t", + "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", + "equation_FStar.UInt.min_int", "equation_FStar.UInt.size", + "equation_FStar.UInt.uint_t", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.int_t", "equation_Lib.IntTypes.maxint", + "equation_Lib.IntTypes.minint", "equation_Lib.IntTypes.pub_int_t", + "equation_Lib.IntTypes.pub_int_v", "equation_Lib.IntTypes.range", + "equation_Lib.IntTypes.signed", "equation_Lib.IntTypes.unsigned", + "equation_Lib.IntTypes.v", + "fuel_guarded_inversion_Lib.IntTypes.inttype", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_83845a86f2550cdf941eeb1d9b59602b", + "refinement_interpretation_Tm_refine_b550ca9347e0645a53715102a08d8fa1", + "refinement_interpretation_Tm_refine_c156ecc6eab05d1687a383ef171435eb", + "refinement_interpretation_Tm_refine_e0b16d74ee3644bd585df5e7938934c6", + "refinement_interpretation_Tm_refine_e450d0eda8ec6ce5c9eff42d01f0e81a", + "refinement_interpretation_Tm_refine_f13070840248fced9d9d60d77bdae3ec", + "typing_FStar.Int16.v", "typing_FStar.Int32.v", + "typing_FStar.Int64.v", "typing_FStar.Int8.v", + "typing_FStar.UInt8.v", "typing_Lib.IntTypes.unsigned", + "typing_Lib.IntTypes.uu___is_S128", "typing_Lib.IntTypes.v", + "typing_tok_Lib.IntTypes.PUB@tok" + ], + 0, + "9bfcda4948ff6c6d67b056436946bfbb" + ] + ] +] \ No newline at end of file diff --git a/tests/hacl/Lib.LoopCombinators.fst.hints b/tests/hacl/Lib.LoopCombinators.fst.hints new file mode 100644 index 00000000000..7eaef893c2c --- /dev/null +++ b/tests/hacl/Lib.LoopCombinators.fst.hints @@ -0,0 +1,1299 @@ +[ + "üt?£Ô•å\u0005%dn²Ü'|", + [ + [ + "Lib.LoopCombinators.repeat_left", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "42d23e335d6b280831add0d597fe8a9f" + ], + [ + "Lib.LoopCombinators.repeat_left", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_1", + "binder_x_ef3cff77d20be12dde95f0777a90f70e_2", + "equation_Prims.eqtype", "equation_Prims.nat", + "function_token_typing_Prims.__cache_version_number__", + "function_token_typing_Prims.int", + "haseqTm_refine_542f9d4f129664613f2483a6c88bc7c2", "int_inversion", + "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_2eb00ca989f9ebed0ed65e52a78766e7", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "well-founded-ordering-on-nat" + ], + 0, + "1307a808ed7f6454f185f3d1ef21c68e" + ], + [ + "Lib.LoopCombinators.repeat_left", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "f309da575b493602dd12b4d3fb97f12d" + ], + [ + "Lib.LoopCombinators.repeat_left_all_ml", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "47dae627966f1a2847fe08179a627cca" + ], + [ + "Lib.LoopCombinators.repeat_left_all_ml", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.eqtype", + "equation_Prims.nat", + "fuel_guarded_inversion_FStar.Pervasives.result", + "function_token_typing_Prims.int", + "haseqTm_refine_542f9d4f129664613f2483a6c88bc7c2", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Equality", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913" + ], + 0, + "09fccd65d1c1deab8168f08fd0e38c2e" + ], + [ + "Lib.LoopCombinators.repeat_left_all_ml", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "bdb464c52aa6d420bfb230631414ff38" + ], + [ + "Lib.LoopCombinators.repeat_right", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "11bfd416bebe9c6ce56462e30ae41258" + ], + [ + "Lib.LoopCombinators.repeat_right", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_1", + "binder_x_ef3cff77d20be12dde95f0777a90f70e_2", + "equation_Prims.eqtype", "equation_Prims.nat", + "function_token_typing_Prims.__cache_version_number__", + "function_token_typing_Prims.int", + "haseqTm_refine_542f9d4f129664613f2483a6c88bc7c2", "int_inversion", + "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_2eb00ca989f9ebed0ed65e52a78766e7", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "well-founded-ordering-on-nat" + ], + 0, + "eb8947142f7aa0989bc3fda9268b099a" + ], + [ + "Lib.LoopCombinators.repeat_right", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "a60674830bbb72ae2aa198d48f8c7ffe" + ], + [ + "Lib.LoopCombinators.repeat_right_all_ml", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "dd4f80d0e603d278671c790fa8f82ec3" + ], + [ + "Lib.LoopCombinators.repeat_right_all_ml", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.eqtype", + "equation_Prims.nat", + "fuel_guarded_inversion_FStar.Pervasives.result", + "function_token_typing_Prims.int", + "haseqTm_refine_542f9d4f129664613f2483a6c88bc7c2", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Equality", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795" + ], + 0, + "a10c05ba359900cc3167262131a3d231" + ], + [ + "Lib.LoopCombinators.repeat_right_all_ml", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "bdb464c52aa6d420bfb230631414ff38" + ], + [ + "Lib.LoopCombinators.repeat_right_plus", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "9d0232c8f38c44386450065fd455b63f" + ], + [ + "Lib.LoopCombinators.repeat_right_plus", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@fuel_irrelevance_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.LoopCombinators_interpretation_Tm_arrow_475c5d8500e6c5accacf8430e17609c1", + "Lib.LoopCombinators_interpretation_Tm_arrow_d923f15fa51c1adf198e41a2a2b838b8", + "binder_x_1643872395c8718ea40fbc2752387c4d_5", + "binder_x_9c1467c8a1dc9d1a9cfdd135b2fced70_3", + "binder_x_af5edae8b4ff911e6a823e510ac6c756_6", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_1", + "binder_x_e1b475a8738f7fad7118cc46529602ed_4", + "binder_x_ef3cff77d20be12dde95f0777a90f70e_2", + "equation_Prims.eqtype", "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "function_token_typing_Prims.int", + "haseqTm_refine_542f9d4f129664613f2483a6c88bc7c2", "int_inversion", + "int_typing", "primitive_Prims.op_Equality", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_2eb00ca989f9ebed0ed65e52a78766e7", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_64e0884aedfcc28624ca5710ec89a7e4", + "refinement_interpretation_Tm_refine_94b4e5d3116d0fdc2008285d6fe3b144", + "refinement_interpretation_Tm_refine_9f4b8102951be8af6f4ece9f995f631e", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795", + "typing_Lib.LoopCombinators.repeat_right", + "well-founded-ordering-on-nat" + ], + 0, + "a137c6d8e5f596d91b56f42f547eefeb" + ], + [ + "Lib.LoopCombinators.repeat_right_plus", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "5241d5e3cefac13fae120a1f9ace42da" + ], + [ + "Lib.LoopCombinators.unfold_repeat_right", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "ac9c2bb342d3d8dd79f60b8e3a6769cd" + ], + [ + "Lib.LoopCombinators.unfold_repeat_right", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@fuel_irrelevance_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795" + ], + 0, + "f171e7e5272d108a26fe6c437dde2cd4" + ], + [ + "Lib.LoopCombinators.unfold_repeat_right", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "a0ccb861a71bc47b569ef13a06bdb1e2" + ], + [ + "Lib.LoopCombinators.eq_repeat_right", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "51042d47a5e2cac57e0a40edde2ba35f" + ], + [ + "Lib.LoopCombinators.eq_repeat_right", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "int_inversion", "primitive_Prims.op_Equality", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795" + ], + 0, + "d9fd8b40efad65b255ca3bf11b1bf65c" + ], + [ + "Lib.LoopCombinators.eq_repeat_right", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "a0ccb861a71bc47b569ef13a06bdb1e2" + ], + [ + "Lib.LoopCombinators.repeat_left_right", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "0fd7a93741cee0204ded991972f24a08" + ], + [ + "Lib.LoopCombinators.repeat_left_right", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_left.fuel_instrumented", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@fuel_irrelevance_Lib.LoopCombinators.repeat_left.fuel_instrumented", + "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.LoopCombinators_interpretation_Tm_arrow_73e03d6f682a7e8a0e2e4caa6e7e006f", + "Lib.LoopCombinators_interpretation_Tm_arrow_e54f60146c15ffc3c6fdfdf188f36184", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "binder_x_15a2a2aa213729b179fdecca4d6d5fcf_5", + "binder_x_57098d7a08a5c655d3e755e495233706_3", + "binder_x_61db9e95f5c6e22c0f798a9af5990a12_4", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_1", + "binder_x_ef3cff77d20be12dde95f0777a90f70e_2", + "equation_Prims.eqtype", "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_left.fuel_instrumented", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "function_token_typing_Prims.__cache_version_number__", + "function_token_typing_Prims.int", + "haseqTm_refine_542f9d4f129664613f2483a6c88bc7c2", "int_inversion", + "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_2eb00ca989f9ebed0ed65e52a78766e7", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_5a9b6c458d60ee3d78bcb9cb8e632018", + "refinement_interpretation_Tm_refine_68812a9442c7946d522ecd05c6a1a9af", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795", + "well-founded-ordering-on-nat" + ], + 0, + "58a194224313f3e0929e898909503f6e" + ], + [ + "Lib.LoopCombinators.repeat_left_right", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "0713b9b066ae8981515276eed533d77b" + ], + [ + "Lib.LoopCombinators.repeat_gen", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "be7a6a147a0fafc2274d790d620fcefe" + ], + [ + "Lib.LoopCombinators.repeat_gen", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "3224e75d8064500709a0f824d69c7eaa" + ], + [ + "Lib.LoopCombinators.repeat_gen", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "2222842d8d3b083fc76c5a333087ddfa" + ], + [ + "Lib.LoopCombinators.repeat_gen_all_ml", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "e6c97eec7a540c912b9cb071cad3417a" + ], + [ + "Lib.LoopCombinators.repeat_gen_all_ml", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "0e67515adb428bb310fe49abc9c2d8ec" + ], + [ + "Lib.LoopCombinators.repeat_gen_all_ml", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "d57e348dfdc73dd1fca38436d72de847" + ], + [ + "Lib.LoopCombinators.unfold_repeat_gen", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "4d82b5454862b6f95f53e98c2d7aaa7f" + ], + [ + "Lib.LoopCombinators.unfold_repeat_gen", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@fuel_irrelevance_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.LoopCombinators_interpretation_Tm_arrow_d14b5cd1226e414731f21670beedcc84", + "Lib.LoopCombinators_interpretation_Tm_arrow_f77e174321f3ceca78193a141927037b", + "equation_Lib.LoopCombinators.repeat_gen", "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795" + ], + 0, + "bbdfab59888d5784b4f41c25da9f9cc0" + ], + [ + "Lib.LoopCombinators.unfold_repeat_gen", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "d52678dd1849e665972f2e48cdc71297" + ], + [ + "Lib.LoopCombinators.eq_repeat_gen0", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "929cbb1edc9c891c7e15c2f726e82351" + ], + [ + "Lib.LoopCombinators.eq_repeat_gen0", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.LoopCombinators_interpretation_Tm_arrow_d14b5cd1226e414731f21670beedcc84", + "Lib.LoopCombinators_interpretation_Tm_arrow_f77e174321f3ceca78193a141927037b", + "equation_Lib.LoopCombinators.repeat_gen", "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "int_inversion", "int_typing", "primitive_Prims.op_Equality", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795" + ], + 0, + "b322355d7af6072fe02c85d6806017ea" + ], + [ + "Lib.LoopCombinators.eq_repeat_gen0", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "d52678dd1849e665972f2e48cdc71297" + ], + [ + "Lib.LoopCombinators.repeat_gen_def", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "d7f01c29d0419205f870dd448bccaf64" + ], + [ + "Lib.LoopCombinators.repeat_gen_def", + 2, + 2, + 1, + [ "@query", "equation_Lib.LoopCombinators.repeat_gen" ], + 0, + "095e7fef79d47ec26b9eb7a7249c24c5" + ], + [ + "Lib.LoopCombinators.repeat_gen_def", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "d52678dd1849e665972f2e48cdc71297" + ], + [ + "Lib.LoopCombinators.eq_repeati0", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "046db2132a7d870326abb99b274f524c" + ], + [ + "Lib.LoopCombinators.eq_repeati0", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "FStar.List.Tot.Properties_interpretation_Tm_arrow_67c7b2626869cb316f118144000415b9", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.LoopCombinators_interpretation_Tm_arrow_c3cac0eaa5a8b41e6eb23c42c4532cc2", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.repeat_gen", + "equation_Lib.LoopCombinators.repeati", "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "function_token_typing_Lib.LoopCombinators.fixed_a", "int_typing", + "primitive_Prims.op_Equality", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795", + "token_correspondence_Lib.LoopCombinators.fixed_a" + ], + 0, + "d6f183c98d7a6afc964187d0c765b8b6" + ], + [ + "Lib.LoopCombinators.unfold_repeati", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "16c18daf88c7ef4e7d19c92badfc45ac" + ], + [ + "Lib.LoopCombinators.unfold_repeati", + 2, + 2, + 1, + [ + "@query", "equation_Lib.LoopCombinators.repeati", + "primitive_Prims.op_Addition" + ], + 0, + "8f65debb5f082da91267766436b14847" + ], + [ + "Lib.LoopCombinators.repeati_def", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "bd786419a577a7005f4e241ff8220ace" + ], + [ + "Lib.LoopCombinators.repeati_def", + 2, + 2, + 1, + [ + "@query", "equation_Lib.LoopCombinators.repeat_gen", + "equation_Lib.LoopCombinators.repeati" + ], + 0, + "e84d4ae365e979edac6d616b661b2274" + ], + [ + "Lib.LoopCombinators.eq_repeat0", + 1, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "FStar.List.Tot.Properties_interpretation_Tm_arrow_67c7b2626869cb316f118144000415b9", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.LoopCombinators_interpretation_Tm_arrow_bfe22415bc48790397b6e21fcc88873f", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.repeat", + "equation_Lib.LoopCombinators.repeat_gen", + "equation_Lib.LoopCombinators.repeati", "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "function_token_typing_Lib.LoopCombinators.fixed_a", + "function_token_typing_Lib.LoopCombinators.fixed_i", "int_typing", + "kinding_Tm_arrow_fcd589b21e6efcf1e5d17b07c282a015", + "primitive_Prims.op_Equality", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795", + "token_correspondence_Lib.LoopCombinators.fixed_a" + ], + 0, + "f5de0c84eaac1537d2f6aa205a9a78ca" + ], + [ + "Lib.LoopCombinators.unfold_repeat", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "d6dc2dd32b539245a4545fc80ffa9789" + ], + [ + "Lib.LoopCombinators.unfold_repeat", + 2, + 2, + 1, + [ + "@query", "equation_Lib.LoopCombinators.fixed_i", + "equation_Lib.LoopCombinators.repeat", "primitive_Prims.op_Addition", + "token_correspondence_Lib.LoopCombinators.fixed_i" + ], + 0, + "2d42eb7b7d777aee941e2d821196f63f" + ], + [ + "Lib.LoopCombinators.repeat_range", + 1, + 2, + 1, + [ "@query" ], + 0, + "3ce4704c270119d40f88ceb3587230a9" + ], + [ + "Lib.LoopCombinators.repeat_range_all_ml", + 1, + 2, + 1, + [ "@query" ], + 0, + "e2a1008ceb72c31d4b9c81a6cd2eaf77" + ], + [ + "Lib.LoopCombinators.repeatable", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "02d14827909e51ef0e384040eae92b7f" + ], + [ + "Lib.LoopCombinators.repeat_range_inductive", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913" + ], + 0, + "25cb649ef24121040c48a5b3d3f08683" + ], + [ + "Lib.LoopCombinators.repeat_range_inductive", + 2, + 2, + 1, + [ "@query" ], + 0, + "9c0bfe78289541ddb04bb655f0ff4cab" + ], + [ + "Lib.LoopCombinators.repeat_range_inductive", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913" + ], + 0, + "49086262ac8d86b397030cb44717775e" + ], + [ + "Lib.LoopCombinators.repeati_inductive", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "8061750c130c1a1647b5463343a389b4" + ], + [ + "Lib.LoopCombinators.repeati_inductive", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "2ae8e4a584123f5793c9817a36e6ca7a" + ], + [ + "Lib.LoopCombinators.repeati_inductive", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "511cd09a2e32914da722d2b7c8b232a9" + ], + [ + "Lib.LoopCombinators.unfold_repeat_right_once", + 1, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@fuel_irrelevance_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_8233d76b57e95451540fc312b717fa79" + ], + 0, + "945afb8831af90fab5d06113cc935a6e" + ], + [ + "Lib.LoopCombinators.unfold_repeat_right_once", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_8233d76b57e95451540fc312b717fa79", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "4b663a34c19381841c547160a0c5eb2c" + ], + [ + "Lib.LoopCombinators.refine_eq", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_8b5d7075e8d63d9e18f39f46674687aa", + "true_interp" + ], + 0, + "1b4b5422a1d8cdc4ffaad7adc3f3f700" + ], + [ + "Lib.LoopCombinators.nat_refine_equiv", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.eq2", + "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "48dfb8e7d5bccd4a95057207cf4a16e7" + ], + [ + "Lib.LoopCombinators.repeati_repeat_left_rewrite_type", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "true_interp" + ], + 0, + "d383a938d1de89630009a2a1c300e87d" + ], + [ + "Lib.LoopCombinators.repeati_repeat_left_rewrite_type", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "351f1ac182a8efacf557afa1b5332c08" + ], + [ + "Lib.LoopCombinators.repeati_inductive_repeat_gen", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "b322ceb7328740d0e7361b7f4ac00fa0" + ], + [ + "Lib.LoopCombinators.repeati_inductive_repeat_gen", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@fuel_irrelevance_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.LoopCombinators_interpretation_Tm_arrow_3b60d90eb1b4e399c18b4b5c4092aefc", + "Lib.LoopCombinators_interpretation_Tm_arrow_42cbb8cae27472bfb50ad5eaa9ec2207", + "Lib.LoopCombinators_interpretation_Tm_arrow_8ccff8122f730b53066e07670f458695", + "Lib.LoopCombinators_interpretation_Tm_arrow_9228bb88100b5a0762d39b5c83174ad9", + "Lib.LoopCombinators_interpretation_Tm_arrow_a5015036cf1762e788e4ccbba6a8d538", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "function_token_typing_Lib.LoopCombinators.a_", + "function_token_typing_Prims.__cache_version_number__", + "int_inversion", "int_typing", + "interpretation_Tm_abs_0e3034507692d95678dac3878d3c5d27", + "interpretation_Tm_abs_0ec465d1eb90963fef662a39d2cdb931", + "interpretation_Tm_abs_b095b3f008ad7213e01e88a9397b957d", + "interpretation_Tm_abs_d0296986d3220e0e72a50647421bdfbe", + "primitive_Prims.op_Addition", "primitive_Prims.op_Equality", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_08698b4b6e166624b5bf789ac071b4cf", + "refinement_interpretation_Tm_refine_0f5d287096bf7dd24d582019e4d18f0c", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_909c0555fed853bc5dc1098d3dd63f21", + "refinement_interpretation_Tm_refine_96e65b2359ce32ff1f5ca9648c355aa6", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795", + "refinement_interpretation_Tm_refine_fe46d1f42dd7ff873261424112f10419", + "refinement_kinding_Tm_refine_08698b4b6e166624b5bf789ac071b4cf", + "token_correspondence_Lib.LoopCombinators.a_", "true_interp", + "typing_Tm_abs_0ec465d1eb90963fef662a39d2cdb931", + "well-founded-ordering-on-nat" + ], + 0, + "208614e84cb01a5ff62e01bb7c3bd913" + ], + [ + "Lib.LoopCombinators.repeati_inductive_repeat_gen", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "511cd09a2e32914da722d2b7c8b232a9" + ], + [ + "Lib.LoopCombinators.preserves_predicate", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "2f547665e150e9bf0def438813b15cfc" + ], + [ + "Lib.LoopCombinators.preserves_predicate", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "89f57e6701114d7a0ad02a5c5f3ed489" + ], + [ + "Lib.LoopCombinators.repeat_gen_inductive", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "fa5ca35e98a2e19142d640239b3073e4" + ], + [ + "Lib.LoopCombinators.repeat_gen_inductive", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@fuel_irrelevance_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.LoopCombinators_interpretation_Tm_arrow_d14b5cd1226e414731f21670beedcc84", + "Lib.LoopCombinators_interpretation_Tm_arrow_f77e174321f3ceca78193a141927037b", + "equation_Lib.LoopCombinators.preserves_predicate", + "equation_Lib.LoopCombinators.repeat_gen", "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_695fc9bad57438f078f1918065bbd3eb", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795" + ], + 0, + "809cb3036bfa98d8212fc2475fc283a2" + ], + [ + "Lib.LoopCombinators.repeat_gen_inductive", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "df07a7d4139455328332292ade1cbd22" + ], + [ + "Lib.LoopCombinators.preserves", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "b125bc03f0526cfa8ab0d4526da1da1b" + ], + [ + "Lib.LoopCombinators.repeati_inductive'", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "e1c6e20ef6264f5706cd72c4cb68f740" + ], + [ + "Lib.LoopCombinators.repeati_inductive'", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@fuel_irrelevance_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "FStar.List.Tot.Properties_interpretation_Tm_arrow_67c7b2626869cb316f118144000415b9", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.LoopCombinators_interpretation_Tm_arrow_c3cac0eaa5a8b41e6eb23c42c4532cc2", + "Lib.LoopCombinators_interpretation_Tm_arrow_f77e174321f3ceca78193a141927037b", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.preserves", + "equation_Lib.LoopCombinators.repeat_gen", + "equation_Lib.LoopCombinators.repeati", "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "function_token_typing_Lib.LoopCombinators.fixed_a", "int_inversion", + "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_41aef3833b617e5c5b9322c9c48c2c29", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795", + "token_correspondence_Lib.LoopCombinators.fixed_a" + ], + 0, + "de1258d1303d84213b7737a1c3acf664" + ] + ] +] \ No newline at end of file diff --git a/tests/hacl/Lib.LoopCombinators.fsti.hints b/tests/hacl/Lib.LoopCombinators.fsti.hints new file mode 100644 index 00000000000..cc43f57b89d --- /dev/null +++ b/tests/hacl/Lib.LoopCombinators.fsti.hints @@ -0,0 +1,383 @@ +[ + "!4É'd8Ï\u0013Á\"Ósøž——", + [ + [ + "Lib.LoopCombinators.repeat_left", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "839bd2597c54301db6a267d696592d12" + ], + [ + "Lib.LoopCombinators.repeat_left_all_ml", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "e9d6fa8fe9910d1dafbe524b8a519ec1" + ], + [ + "Lib.LoopCombinators.repeat_right", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "11bfd416bebe9c6ce56462e30ae41258" + ], + [ + "Lib.LoopCombinators.repeat_right_all_ml", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "8537cee7419a0dbff7ba6f201132dcfa" + ], + [ + "Lib.LoopCombinators.repeat_right_plus", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "098023b53fbe0a0cf21f8ca3fe7306a6" + ], + [ + "Lib.LoopCombinators.unfold_repeat_right", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "d1e2e52f5f35a9a5aa35ac8208bf8e85" + ], + [ + "Lib.LoopCombinators.eq_repeat_right", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "7252bda296e1e02ae519ce306f1a0ebe" + ], + [ + "Lib.LoopCombinators.repeat_left_right", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "a47e1af9d9759cf20b4b047f3ffea541" + ], + [ + "Lib.LoopCombinators.repeat_gen", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "123d7a4ac937bb148a355d571844003e" + ], + [ + "Lib.LoopCombinators.repeat_gen_all_ml", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "f511c47ed6ed0c20c576795e2792a70a" + ], + [ + "Lib.LoopCombinators.unfold_repeat_gen", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "883417d725fe16c26731a38b486d86f7" + ], + [ + "Lib.LoopCombinators.eq_repeat_gen0", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "be59e5fc1c93e424a26b605558b1a3e6" + ], + [ + "Lib.LoopCombinators.repeat_gen_def", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "4c5b07231938249ea16d30e204241399" + ], + [ + "Lib.LoopCombinators.eq_repeati0", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "350a3c637587dc8f780393b815af27a1" + ], + [ + "Lib.LoopCombinators.unfold_repeati", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "4f1bd5a264456699f5188b911672333b" + ], + [ + "Lib.LoopCombinators.repeati_def", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "4a8d037f4cfe1af2737a18b901c8a7e4" + ], + [ + "Lib.LoopCombinators.unfold_repeat", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "fa2326a9d4a46a36e5160e8d0ce94f33" + ], + [ + "Lib.LoopCombinators.repeatable", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "2bd27224e5de7273c18134faa07c620f" + ], + [ + "Lib.LoopCombinators.repeat_range_inductive", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913" + ], + 0, + "f68ddefcab6a7551484d851f055e8c6d" + ], + [ + "Lib.LoopCombinators.repeati_inductive", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "0444734b2a69655606da45bab8ed87cb" + ], + [ + "Lib.LoopCombinators.repeati_inductive_repeat_gen", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "ef93a8bce90c0358013ecc325ed4f1dc" + ], + [ + "Lib.LoopCombinators.preserves_predicate", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "2f547665e150e9bf0def438813b15cfc" + ], + [ + "Lib.LoopCombinators.preserves_predicate", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "89f57e6701114d7a0ad02a5c5f3ed489" + ], + [ + "Lib.LoopCombinators.repeat_gen_inductive", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "fa5ca35e98a2e19142d640239b3073e4" + ], + [ + "Lib.LoopCombinators.preserves", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "6a5117b0db999ebc66c9c08bac09b900" + ], + [ + "Lib.LoopCombinators.repeati_inductive'", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "e1c6e20ef6264f5706cd72c4cb68f740" + ] + ] +] \ No newline at end of file diff --git a/tests/hacl/Lib.Sequence.Lemmas.fst b/tests/hacl/Lib.Sequence.Lemmas.fst index d819a097ee1..c7941e93f86 100644 --- a/tests/hacl/Lib.Sequence.Lemmas.fst +++ b/tests/hacl/Lib.Sequence.Lemmas.fst @@ -122,7 +122,7 @@ let len0_div_bs blocksize len len0 = len / blocksize; } - +#push-options "--z3rlimit 60" let split_len_lemma0 blocksize n len0 = let len = n * blocksize in let len1 = len - len0 in @@ -142,7 +142,7 @@ let split_len_lemma0 blocksize n len0 = len0_div_bs blocksize len len0 //assert (n0 + n1 = n) - +#pop-options let split_len_lemma blocksize len len0 = let len1 = len - len0 in diff --git a/tests/hacl/Lib.Sequence.Lemmas.fst.hints b/tests/hacl/Lib.Sequence.Lemmas.fst.hints new file mode 100644 index 00000000000..8ce43f7d9d4 --- /dev/null +++ b/tests/hacl/Lib.Sequence.Lemmas.fst.hints @@ -0,0 +1,2818 @@ +[ + "Æ\u0006\u001aæÕF”`5©\u0007\fqé$R", + [ + [ + "Lib.Sequence.Lemmas.get_block_s", + 1, + 8, + 2, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", + "@fuel_irrelevance_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "lemma_FStar.UInt.pow2_values", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3833667c59aecdf581ef615fb6194b08", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_ade7773d9cd7cd1a2abc2fe3f191b9e0", + "refinement_interpretation_Tm_refine_c37230a0b45bfa733513e4ce89ef34d6", + "typing_FStar.Seq.Base.length" + ], + 0, + "7c654633c5d33eff5d047584e6f0cc6d" + ], + [ + "Lib.Sequence.Lemmas.get_block_s", + 2, + 2, + 1, + [ "@query" ], + 0, + "2c77a5ff2bfe7cfbff3266294c732df9" + ], + [ + "Lib.Sequence.Lemmas.get_last_s", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3833667c59aecdf581ef615fb6194b08", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "typing_FStar.Seq.Base.length" + ], + 0, + "3984449af17cab6d28487c4a359f0ee3" + ], + [ + "Lib.Sequence.Lemmas.repeati_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_c3cac0eaa5a8b41e6eb23c42c4532cc2", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_e7e6bda13570450ba98cae3dc5e7dd42", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "binder_x_6781041e5072f14a03af8b07643f1f30_4", + "binder_x_b3a9ce008df0278184098b1a723bca0c_3", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_1", + "binder_x_fe28d8bcde588226b4e538b35321de05_0", "equation_Prims.nat", + "function_token_typing_Prims.__cache_version_number__", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3e839a4d245a3beb00e03b7402cb44c7", + "refinement_interpretation_Tm_refine_49c0ba66edcf02816cc411af6df0f144", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.LoopCombinators.repeati", "well-founded-ordering-on-nat" + ], + 0, + "eaa3563a15900c044a4a3a189de84eda" + ], + [ + "Lib.Sequence.Lemmas.repeat_right_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_12aaa86fce4296e5ca537def690c90b7", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "refinement_interpretation_Tm_refine_fd19feb5f9ea77c43306cb5b7a87bc36" + ], + 0, + "406edcd644b73494537bf7f4cb39edcf" + ], + [ + "Lib.Sequence.Lemmas.repeat_right_extensionality", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_3c9ffd2296420cd469cf20686505163b", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_bd7c7ab284b6accd96708c0ff3164304", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "binder_x_03d51f0b26b266821854328111855af2_3", + "binder_x_b730587d8140e227a7f8adbd92d65106_5", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_1", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_2", + "binder_x_d26ec331d6bcfdfd046bf0c1c673bcf9_7", "equation_Prims.nat", + "function_token_typing_Prims.__cache_version_number__", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_303b9c87ad41f9e78fc62ab2390b0125", + "refinement_interpretation_Tm_refine_3e9b52cb3027f42e52803d569c244fcb", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_57bc50f9aa6e93b9844a8bd63512cb1c", + "refinement_interpretation_Tm_refine_94dd066518be63a31245723626aaa707", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795", + "typing_Lib.LoopCombinators.repeat_right", + "well-founded-ordering-on-nat" + ], + 0, + "a859644aabe10c0abed6fe28cfa1adf2" + ], + [ + "Lib.Sequence.Lemmas.repeat_right_extensionality", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_12aaa86fce4296e5ca537def690c90b7", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_8329caf005c3be2e24a9ce0a366d6277", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "refinement_interpretation_Tm_refine_fd19feb5f9ea77c43306cb5b7a87bc36" + ], + 0, + "bcaee63886ba6b779a1fda2857521515" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_right_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c521dec61896a844c454ea9692ebf2e2", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2" + ], + 0, + "c7e3bd31af014960a704180a89418e6b" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_right_extensionality", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_27ab71f0fb6c81f0fa9dbba5ba46be75", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_809f84adfa1ee74319c7b9bd8825d36a", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "binder_x_759fff43cce3e9ec96895cb58a55ec68_3", + "binder_x_82e1062e5a8fb0849c9f621f85a4d628_5", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_1", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_2", + "binder_x_de4df547607739c850b1e55a67a124fe_7", "equation_Prims.nat", + "function_token_typing_Prims.__cache_version_number__", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3e839a4d245a3beb00e03b7402cb44c7", + "refinement_interpretation_Tm_refine_49c0ba66edcf02816cc411af6df0f144", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_5d8689c3031a6af8b5491cc44c84ab43", + "refinement_interpretation_Tm_refine_6536ede8f313b115412245fc854378bd", + "refinement_interpretation_Tm_refine_b61962d44f25224004938818b1c4cd7b", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795", + "typing_Lib.LoopCombinators.repeat_right", + "well-founded-ordering-on-nat" + ], + 0, + "8a395c16a98e5214cefb0be8cadd665f" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_right_extensionality", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6b17b387345777bc1396aeb424031d6e", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c521dec61896a844c454ea9692ebf2e2", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2" + ], + 0, + "3490ef73f9ad91a6d9fca421f38d126c" + ], + [ + "Lib.Sequence.Lemmas.repeati_right_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "1e5c5e551a8e3a4dc1c373c935e75cce" + ], + [ + "Lib.Sequence.Lemmas.repeati_right_extensionality", + 2, + 0, + 0, + [ "@query", "equation_Lib.LoopCombinators.fixed_a" ], + 0, + "1fe9b5fe8c670decc5633ab2d9d7df9f" + ], + [ + "Lib.Sequence.Lemmas.repeati_right_shift", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "d481cbf3301cd88265c80094526453d3" + ], + [ + "Lib.Sequence.Lemmas.repeati_right_shift", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "17d2ab22da8d5558830bece763178536" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_f", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_bbe86a0a6209b8c07083cd4c9f7f9aa5", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803" + ], + 0, + "a00a7009968eea744c749b3be3065a87" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_f", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "0927629e3ed42ee492a718052daf7730" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "febc0f4599642c93b2a973c844219652" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953" + ], + 0, + "503bf7e8f926950fd78364979e10da14" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "9466afe2e02023fa8e68909f4a6951d5" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_gen_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "508f048f7c8ded0d03dc99467c6ad26b" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_gen_blocks_multi", + 2, + 0, + 0, + [ "@query", "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_multi" ], + 0, + "eee1506dd52a696caed84f2b79cc883e" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_gen_blocks_multi", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "9466afe2e02023fa8e68909f4a6951d5" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "6ba7aabe50f5369312457c59568da8a4" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_FStar.Seq.Base.length", "typing_Lib.Sequence.length" + ], + 0, + "eb69b0ece798919f8f172e37b9ff05d5" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "7ff7dd8416d02481c9876e77d0237d72" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_gen_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_FStar.Seq.Base.length", "typing_Lib.Sequence.length" + ], + 0, + "3b40b44dba58aa6bbb0be2b806699f54" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_gen_blocks", + 2, + 0, + 0, + [ "@query", "equation_Lib.Sequence.Lemmas.repeat_gen_blocks" ], + 0, + "0a61b896b9e112ca639ff6cf3d9a4475" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_gen_blocks", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "76c06152ef69ffe6dee6d36d78231460" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_extensionality_zero", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_46d0490fc1bcee17b1822abbbaec9be9", + "refinement_interpretation_Tm_refine_4a1f484c8b51af7634bbc9267ad1b558", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "6ffd942f74bc79f31d6465dba340c254" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_extensionality_zero", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_f", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_46d0490fc1bcee17b1822abbbaec9be9", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_ba24c249c2bac9c9652dccf45aee8033", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.slice" + ], + 0, + "7e1bf405724dfbfec1b64abc8efca766" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_extensionality_zero", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_46d0490fc1bcee17b1822abbbaec9be9", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "4a0135838af7d2c2625f2c9e1fea8e4f" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_extensionality_zero", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_46d0490fc1bcee17b1822abbbaec9be9", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_667c0deceb286bd669e5316a684eee1c", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c8d0b9c0d9bab47c0f00a15221dd05c4" + ], + 0, + "b029ce6442f68400e1aff9b601af9351" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_extensionality_zero", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_46d0490fc1bcee17b1822abbbaec9be9", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c8d0b9c0d9bab47c0f00a15221dd05c4", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_Lib.Sequence.length" + ], + 0, + "fbbc91114e9c6e887aaf9dae992f312e" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_extensionality_zero", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_46d0490fc1bcee17b1822abbbaec9be9", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "4db07a86005ae2913812230e0a699ab7" + ], + [ + "Lib.Sequence.Lemmas.len0_div_bs", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "b4e99340719ec572369c358731976f87" + ], + [ + "Lib.Sequence.Lemmas.len0_div_bs", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "648f140407eb9b5cf2cbe68a4335540a" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "1cc8a6e9d8e9179cc5817d4fb9464b86" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "4d67f6c4647719e433ec5a8fc8b35c91" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 4, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "1b4819271ef6ec5a269529dab1a9a246" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 5, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_4c113fc8b5082d9ae06254757e19cb42" + ], + 0, + "a98863bc6713ba83b34ce00718620ac6" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 6, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", + "primitive_Prims.op_Equality", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_4c113fc8b5082d9ae06254757e19cb42", + "refinement_interpretation_Tm_refine_4d93f3edc564d0fc940fa1f17194690a" + ], + 0, + "bcc5bd2231781a07a95ce182ed422efc" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 7, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_4c113fc8b5082d9ae06254757e19cb42", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "9845b33b20d1651b26b71acb4ad1d4ed" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 8, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_4c113fc8b5082d9ae06254757e19cb42" + ], + 0, + "3b0065871549118ad6674d96e05ec761" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 9, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_4c113fc8b5082d9ae06254757e19cb42" + ], + 0, + "090c77d113a0902c64fbbdf4b30b548d" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 10, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Equality", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3dc80b2da0a2c54db945f37042ca080a", + "refinement_interpretation_Tm_refine_4c113fc8b5082d9ae06254757e19cb42", + "refinement_interpretation_Tm_refine_4d93f3edc564d0fc940fa1f17194690a", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_f4357f3bafc6bf7c1dfbd5c602dd3c90", + "unit_inversion" + ], + 0, + "5b0d5ba69c4f8493301c7c2cb36008d9" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "04bd24a0fbf439208b78058fbd99ec27" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "8c30bd2cb791bd48e61bc77ddccf7167" + ], + [ + "Lib.Sequence.Lemmas.aux_repeat_bf_s0", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_24813cd65ccef7cf8c09228ba9bdbf64", + "refinement_interpretation_Tm_refine_3b00410d9ccdeee0a4c7af332e73ce2f", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_9b859045a8681d0937b4cb9681dd787b", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "typing_Lib.Sequence.length" + ], + 0, + "6b7f8948a351ca1a7003c65571b44531" + ], + [ + "Lib.Sequence.Lemmas.aux_repeat_bf_s0", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_f", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_24813cd65ccef7cf8c09228ba9bdbf64", + "refinement_interpretation_Tm_refine_3b00410d9ccdeee0a4c7af332e73ce2f", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_9b859045a8681d0937b4cb9681dd787b", + "refinement_interpretation_Tm_refine_bbe86a0a6209b8c07083cd4c9f7f9aa5", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2" + ], + 0, + "258dff45e3b38a69ab977090ea00c055" + ], + [ + "Lib.Sequence.Lemmas.aux_repeat_bf_s0", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "7c2b2d1d3abb4fcfbc9350e75ef0b7d5" + ], + [ + "Lib.Sequence.Lemmas.aux_repeat_bf_s1", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_24813cd65ccef7cf8c09228ba9bdbf64", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c215e983d7915709bebb4fb7be5bb946", + "refinement_interpretation_Tm_refine_d478cde3e691462712f56114befc57a5", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "typing_Lib.Sequence.length" + ], + 0, + "9d0babf6659f36c2d79b869c30f94b09" + ], + [ + "Lib.Sequence.Lemmas.aux_repeat_bf_s1", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_f", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_24813cd65ccef7cf8c09228ba9bdbf64", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_bbe86a0a6209b8c07083cd4c9f7f9aa5", + "refinement_interpretation_Tm_refine_c215e983d7915709bebb4fb7be5bb946", + "refinement_interpretation_Tm_refine_d478cde3e691462712f56114befc57a5", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "typing_Lib.Sequence.length" + ], + 0, + "15019e1813dd324d06e59423e5955dff" + ], + [ + "Lib.Sequence.Lemmas.aux_repeat_bf_s1", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "ff34d7e53833e9f859be542fcf113c69" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_split", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_24813cd65ccef7cf8c09228ba9bdbf64", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "5be8e8b1c463aa1991b0d5d78a01fa05" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_split", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_24813cd65ccef7cf8c09228ba9bdbf64", + "refinement_interpretation_Tm_refine_3b00410d9ccdeee0a4c7af332e73ce2f", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_9b859045a8681d0937b4cb9681dd787b", + "refinement_interpretation_Tm_refine_c215e983d7915709bebb4fb7be5bb946", + "refinement_interpretation_Tm_refine_d478cde3e691462712f56114befc57a5", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "typing_Lib.Sequence.length" + ], + 0, + "65380ffee5d8f1474c3763b4d77563e6" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_split", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "75362b97f5739d077b9ebb6632285caf" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_split_slice", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_784bfde0144e58d81243bc1b47b4f0ec", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c2f575b3d23d23189e5d12bd5a9e4337", + "typing_Lib.Sequence.length" + ], + 0, + "7ff0adcfe7f6769ad79a31d377a33c85" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_split_slice", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "lemma_FStar.Seq.Properties.slice_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1ba8fd8bb363097813064c67740b2de5", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_784bfde0144e58d81243bc1b47b4f0ec", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c2f575b3d23d23189e5d12bd5a9e4337", + "refinement_interpretation_Tm_refine_d3d07693cd71377864ef84dc97d10ec1", + "typing_Lib.Sequence.length" + ], + 0, + "2124bbc1a73873053eb5221d44751ce0" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_split_slice", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_784bfde0144e58d81243bc1b47b4f0ec", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "5d05d735012102769c2be77c99c738c7" + ], + [ + "Lib.Sequence.Lemmas.slice_slice_last", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_725406258cbec7cb7a61bee1d844d771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "typing_Lib.Sequence.length" + ], + 0, + "7b80da2d3be8b1ad1864bc6693d1ea46" + ], + [ + "Lib.Sequence.Lemmas.slice_slice_last", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_eq_intro", + "lemma_FStar.Seq.Base.lemma_index_slice", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_35a0739c434508f48d0bb1d5cd5df9e8", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_725406258cbec7cb7a61bee1d844d771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_d3d07693cd71377864ef84dc97d10ec1", + "refinement_interpretation_Tm_refine_d83f8da8ef6c1cb9f71d1465c1bb1c55", + "typing_FStar.Seq.Base.length", "typing_FStar.Seq.Base.slice", + "typing_Lib.Sequence.length" + ], + 0, + "7d41b93e14ad5526497d3abb38aa1d8f" + ], + [ + "Lib.Sequence.Lemmas.slice_slice_last", + 3, + 0, + 0, + [ "@query" ], + 0, + "3ed5771c6f7a010dab1b2b08bc63a8a6" + ], + [ + "Lib.Sequence.Lemmas.len0_le_len_fraction", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "828d4ad68b28d887e8fbffc84a29ede7" + ], + [ + "Lib.Sequence.Lemmas.len0_le_len_fraction", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Division", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "bfb194245dda4b86f9a1e6c3f3790c65" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_split", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_fcf14b481b3a84f47b67fc1dd0096ca5", + "typing_Lib.Sequence.length" + ], + 0, + "97be12b972dac0ae7c751951c8dda395" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_split", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "lemma_FStar.Seq.Properties.slice_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1ba8fd8bb363097813064c67740b2de5", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_75e501c8cccef1c521502f88a4640586", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_d3d07693cd71377864ef84dc97d10ec1", + "refinement_interpretation_Tm_refine_fcf14b481b3a84f47b67fc1dd0096ca5", + "typing_FStar.Seq.Base.length", "typing_Lib.Sequence.length" + ], + 0, + "39618b0945d1f06a36fdcf5928a6833e" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_split", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "dabdaca207d0536138718f221a896d92" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "421f8ee245d06012b584aa808ac28f55" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_extensionality", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.repeat_blocks_f", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6ec36165acc8b3b8a1f151af217f53b8", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7af7abfd9fa791df66706ab563886df2", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_FStar.Seq.Base.length", "typing_FStar.Seq.Base.slice", + "typing_Lib.Sequence.length" + ], + 0, + "ffb404b5984d0c9ac437a5c0c6302c30" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_extensionality", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "63d0028fa5427efd2fc741e34c0ca3f6" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_blocks_via_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "typing_FStar.Seq.Base.length", "typing_Lib.Sequence.length" + ], + 0, + "09b3cbc6b05b6f077270c6fbe2010712" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_blocks_via_multi", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.repeat_blocks_f", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7af7abfd9fa791df66706ab563886df2", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c2f575b3d23d23189e5d12bd5a9e4337", + "typing_Lib.Sequence.length" + ], + 0, + "383c93d245486a81d22ae5a5a1f3504f" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_blocks_via_multi", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "478acc8f2ca5cb76f106a032715171f6" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_is_repeat_gen_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_dc64ef62fd3101207c953516420ca99f", + "typing_Lib.Sequence.length" + ], + 0, + "f83f0fd41740917e110dc57d59847e83" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_is_repeat_gen_blocks_multi", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.fixed_i", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_f", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + "equation_Lib.Sequence.length", + "equation_Lib.Sequence.repeat_blocks_f", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7a73c35877b307cf436e11329be9e855", + "refinement_interpretation_Tm_refine_7af7abfd9fa791df66706ab563886df2", + "refinement_interpretation_Tm_refine_dc64ef62fd3101207c953516420ca99f", + "token_correspondence_Lib.LoopCombinators.fixed_i", + "typing_Lib.Sequence.length" + ], + 0, + "1994770f13f0840e7af546b6ceb123a7" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_is_repeat_gen_blocks_multi", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "0900955b4866ce9f200ce6b55735f6d9" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_is_repeat_gen_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_f571f2610f867b24665eec96f119e18c" + ], + 0, + "6073e72ede924dec338910e78811a0c2" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_is_repeat_gen_blocks", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.LoopCombinators.fixed_i", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c2f575b3d23d23189e5d12bd5a9e4337", + "refinement_interpretation_Tm_refine_f571f2610f867b24665eec96f119e18c", + "token_correspondence_Lib.LoopCombinators.fixed_i", + "typing_Lib.Sequence.length" + ], + 0, + "739fd8666a9a903ed9e12c284e11c943" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_is_repeat_gen_blocks", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "b8d3b3cf258d0533d311e39cad611b04" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_split", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_5e9c3dad358c3890f342f5eeb42bb76e", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "typing_Lib.Sequence.length" + ], + 0, + "c31c75e22efd0941b2b66dd0a69debea" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_split", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.fixed_i", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_5e9c3dad358c3890f342f5eeb42bb76e", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "token_correspondence_Lib.LoopCombinators.fixed_i", + "typing_Lib.Sequence.length" + ], + 0, + "4df66fe0b1d0e0ee8831e0ac2254c8f8" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_split", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "e14fa65ddcf58954f69fe3878e125dc2" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_split", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_725406258cbec7cb7a61bee1d844d771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647" + ], + 0, + "894f2441bdf52ea1a8f718ea6eaa7eee" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_split", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.fixed_i", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_725406258cbec7cb7a61bee1d844d771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "token_correspondence_Lib.LoopCombinators.fixed_i", + "typing_Lib.Sequence.length" + ], + 0, + "4122cf2392b3e015198cc6e19ceedcf2" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_split", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "1480db896329c272ad33287803b70fa5" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "867519bf6570af19717f8b75181dd674" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_extensionality", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.repeat_blocks_f", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6ec36165acc8b3b8a1f151af217f53b8", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7af7abfd9fa791df66706ab563886df2", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_b14928a18ba707004108386997fed9d6", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_FStar.Seq.Base.length", "typing_FStar.Seq.Base.slice", + "typing_Lib.Sequence.length" + ], + 0, + "e3847c20433eadda194767a4910aa6e4" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_extensionality", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "fb8570aa8fa0661f8663ade903377e5f" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "7f1ae5098f08a3f8961751db419ee888" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_extensionality", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_a203639a647d7d28da9a0faccf0492b8", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", + "equation_Lib.Sequence.map_blocks_f", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", + "function_token_typing_Lib.Sequence.map_blocks_f", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_b913a3f691ca99086652e0a655e72f17", + "refinement_interpretation_Tm_refine_ba24c249c2bac9c9652dccf45aee8033", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.empty", "typing_FStar.Seq.Base.length", + "typing_FStar.Seq.Base.slice", "typing_Lib.Sequence.length" + ], + 0, + "d86113619d5dfa6964bfc021cc8112e2" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_extensionality", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "a0c73b343c5267daf364aea581810ec3" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Division", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "71c748893493cb0121d41f891f188bc0" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_extensionality", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Division", "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c2f575b3d23d23189e5d12bd5a9e4337", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_FStar.Seq.Base.slice", "typing_Lib.Sequence.length" + ], + 0, + "b276be0802a3664829ba1c42a66586db" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_extensionality", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "b5556906371c86d0fc49a0a66be2d63a" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.Sequence_interpretation_Tm_arrow_d3b9c37343cabe37d3e11c0a1cafa7da", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.append", "typing_FStar.Seq.Base.length" + ], + 0, + "e8c0ab324bffb96ef7169eed9e4522ea" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "599590beedd4b6cebbc35acd10c72467" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "065f3b8efda7df980bdb0a3993c32b75" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_l_length", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "4071eb23d9372cc7cc8fc364275be174" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_l_length", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_9dbede814c7e09cf989d879ebca4b33a", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803" + ], + 0, + "39a2661d12725cea0bd8e45d81c768cd" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_l_length", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "08eceb4997c6059cfdaf24038417dc51" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "79bbdb878e6e793f665cedc320893327" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.Sequence.map_blocks_a", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803" + ], + 0, + "c9251bb5343e24439ee51cb8717b65e8" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "4d708b4d072f4252c5023f5b7c5c8007" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "3837a1a5e85d27c54374765b1a9658ee" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc", + 2, + 0, + 0, + [ "@query" ], + 0, + "7040b7fdf98070b6cc9e8a4990ae8bff" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "6f65958c8a29c51eac42f3edea36d2e7" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_length", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "5e0cb45533615c3637003f5d052eb368" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_length", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_d14b5cd1226e414731f21670beedcc84", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_9b21a1b8a923031d12df037faf12ac8b", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_9dbede814c7e09cf989d879ebca4b33a", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_f0f2eb385217bc59a5339bff3d4fdc88", + "Lib.Sequence_interpretation_Tm_arrow_1197f9e1e382c8da76b7fab929cab890", + "equation_Lib.Sequence.Lemmas.map_blocks_acc", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", + "function_token_typing_Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + "function_token_typing_Lib.Sequence.map_blocks_a", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_append", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "token_correspondence_Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + "token_correspondence_Lib.Sequence.map_blocks_a", + "typing_FStar.Seq.Base.slice", + "typing_Lib.Sequence.Lemmas.map_blocks_acc", + "typing_Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + "typing_Lib.Sequence.length" + ], + 0, + "e53833026cc4ee0db6a7c0f9c7635b3a" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_length", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "6f65958c8a29c51eac42f3edea36d2e7" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_repeat_gen_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "58ed23c62052a769b156f1769d1b6579" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_repeat_gen_blocks_multi", + 2, + 0, + 0, + [ "@query", "equation_Lib.Sequence.Lemmas.map_blocks_multi_acc" ], + 0, + "e138576d433dfc30d3b14cc931d674fd" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_repeat_gen_blocks_multi", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "4d708b4d072f4252c5023f5b7c5c8007" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_repeat_gen_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "f7f0705d2df658307ec5db8539be40f4" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_repeat_gen_blocks", + 2, + 0, + 0, + [ "@query", "equation_Lib.Sequence.Lemmas.map_blocks_acc" ], + 0, + "8668f74640623b721b097db0f370e0ed" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_repeat_gen_blocks", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "6f65958c8a29c51eac42f3edea36d2e7" + ], + [ + "Lib.Sequence.Lemmas.f_shift", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "8fc4707756373e140abe565e04d6fc4b" + ], + [ + "Lib.Sequence.Lemmas.f_shift", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "a051ac7c04d8839a4d26b38cac32d40f" + ], + [ + "Lib.Sequence.Lemmas.l_shift", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d" + ], + 0, + "d787d49b705dcea1916bcd5777bd9d74" + ], + [ + "Lib.Sequence.Lemmas.l_shift", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213" + ], + 0, + "29265487f3dbfc30d2aae9e4b473b73d" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi_", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_b913a3f691ca99086652e0a655e72f17", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_cedbfc1f9a0199ea1d2d039a83d0b50f", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.empty", "typing_Lib.Sequence.length" + ], + 0, + "3a969b0452d738472d73f700e1dfc6e2" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi_", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "binder_x_7eea0d406be960c32731035419902146_1", + "binder_x_80398975436b9f074cafa4c1f371bbf6_8", + "binder_x_9caa9576d4c1ad3b0e97ef91b12afd21_5", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_2", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_3", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_4", + "binder_x_d9bc8e0a60310fd244ff2d1ff9c0be7d_6", + "binder_x_fe28d8bcde588226b4e538b35321de05_0", + "equation_Lib.Sequence.Lemmas.f_shift", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_f", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", + "equation_Lib.Sequence.map_blocks_f", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", + "function_token_typing_Lib.Sequence.map_blocks_a", + "function_token_typing_Prims.__cache_version_number__", + "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_append", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Equality", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_8a6506292ccc20eb5c4cf1d8460ddbdb", + "refinement_interpretation_Tm_refine_97a1d43cbd9a511b7df6dadef7f89fb8", + "refinement_interpretation_Tm_refine_a4a397079d7ea76ab85443b1137ac121", + "refinement_interpretation_Tm_refine_aacd5c5013e5b4b181bda5c667bdb087", + "refinement_interpretation_Tm_refine_b913a3f691ca99086652e0a655e72f17", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_db4109dc6119e88b617d40a03dd5557c", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "token_correspondence_Lib.Sequence.Lemmas.f_shift", + "token_correspondence_Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + "typing_FStar.Seq.Base.empty", "typing_FStar.Seq.Base.length", + "typing_Lib.Sequence.length", "well-founded-ordering-on-nat" + ], + 0, + "b75fcee83e78a8a4611a446d74250a43" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi_", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_b913a3f691ca99086652e0a655e72f17", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_cedbfc1f9a0199ea1d2d039a83d0b50f", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "refinement_interpretation_Tm_refine_fa99d08257545a32939a8ec97d8ccbff", + "typing_FStar.Seq.Base.empty", "typing_Lib.Sequence.length" + ], + 0, + "581a0b5bd4273d1857e841a8930ab8bd" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "3b5a6ca7f2d72a660bea4f4f9b93f50f" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.Sequence.Lemmas.map_blocks_multi_acc", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.map_blocks_a", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", + "function_token_typing_Lib.Sequence.map_blocks_a", "int_inversion", + "lemma_FStar.Seq.Base.lemma_eq_refl", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_b913a3f691ca99086652e0a655e72f17", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.empty" + ], + 0, + "49082c5ee001850d7acb1b7d8a22b9f8" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "4d708b4d072f4252c5023f5b7c5c8007" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_map_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "b50981bc602abeead21ffb735a6e4dae" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_map_blocks", + 2, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_1c8e3695441d6e943fd420c55a9c2714", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_2157ab19016ce78d1a8477b3e4a9fd74", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_53c1cff0fc95f4065a8aa916a14dae1d", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_584846cea09f289341a40139c3b43b94", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_707f1100325826b024437354577c9bb0", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_9dbede814c7e09cf989d879ebca4b33a", + "Lib.Sequence_interpretation_Tm_arrow_d3b9c37343cabe37d3e11c0a1cafa7da", + "Lib.Sequence_interpretation_Tm_arrow_efd714987712642bce73b6a439af3d22", + "Lib.Sequence_interpretation_Tm_arrow_f67e6b48b3d5d38ee7701f3b137f9030", + "equation_Lib.Sequence.Lemmas.l_shift", + "equation_Lib.Sequence.Lemmas.map_blocks_acc", + "equation_Lib.Sequence.Lemmas.map_blocks_multi_acc", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", + "function_token_typing_Lib.Sequence.Lemmas.f_shift", + "function_token_typing_Lib.Sequence.Lemmas.l_shift", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_eq_elim", + "lemma_FStar.Seq.Base.lemma_eq_intro", + "lemma_FStar.Seq.Base.lemma_index_app1", + "lemma_FStar.Seq.Base.lemma_index_app2", + "lemma_FStar.Seq.Base.lemma_len_append", + "lemma_FStar.Seq.Base.lemma_len_slice", + "lemma_Lib.Sequence.Lemmas.map_blocks_acc_length", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1f6c16a51cd4ba3256b95ca590c832c5", + "refinement_interpretation_Tm_refine_25699f4de0c949c68e992e5573c8bf6d", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7af7abfd9fa791df66706ab563886df2", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_8710a3dcbb7aeecb1da33ddf8070b919", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "refinement_interpretation_Tm_refine_ac201cf927190d39c033967b63cb957b", + "refinement_interpretation_Tm_refine_b7cc00be09baf214a201979bf5a5cea0", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c2f575b3d23d23189e5d12bd5a9e4337", + "refinement_interpretation_Tm_refine_d83f8da8ef6c1cb9f71d1465c1bb1c55", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_dee0f34b44c44e6d512c6db0858b92ef", + "refinement_interpretation_Tm_refine_ef88cbfd1f224cec1819e89cfa0f6a00", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "token_correspondence_Lib.Sequence.Lemmas.f_shift", + "token_correspondence_Lib.Sequence.Lemmas.l_shift", + "token_correspondence_Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + "typing_FStar.Seq.Base.append", "typing_FStar.Seq.Base.slice", + "typing_Lib.Sequence.Lemmas.map_blocks_acc", + "typing_Lib.Sequence.Lemmas.map_blocks_multi_acc", + "typing_Lib.Sequence.length", "typing_Lib.Sequence.map_blocks", + "typing_Lib.Sequence.map_blocks_multi" + ], + 0, + "890694cd2e59ece4d280611b88d15694" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_map_blocks", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "6f65958c8a29c51eac42f3edea36d2e7" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi0", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d" + ], + 0, + "77a205731ace8eccd2bff6b5ff09149e" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi0", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_d14b5cd1226e414731f21670beedcc84", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_9b21a1b8a923031d12df037faf12ac8b", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_f0f2eb385217bc59a5339bff3d4fdc88", + "Lib.Sequence_interpretation_Tm_arrow_1197f9e1e382c8da76b7fab929cab890", + "equation_Lib.Sequence.Lemmas.f_shift", + "equation_Lib.Sequence.Lemmas.map_blocks_multi_acc", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.map_blocks_a", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", + "function_token_typing_Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + "function_token_typing_Lib.Sequence.map_blocks_a", "int_inversion", + "lemma_FStar.Seq.Base.lemma_eq_elim", + "lemma_FStar.Seq.Base.lemma_eq_refl", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_361ceade980020b5c15ebf36d114dc78", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_b913a3f691ca99086652e0a655e72f17", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "token_correspondence_Lib.Sequence.Lemmas.f_shift", + "token_correspondence_Lib.Sequence.map_blocks_a", + "typing_FStar.Seq.Base.empty", + "typing_Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + "typing_Lib.Sequence.length" + ], + 0, + "83c4012cc03867f3198e27844fa967bb" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi0", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "40877c5325e5393546920d1666122dda" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_map_blocks0", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_f571f2610f867b24665eec96f119e18c" + ], + 0, + "4e2d13e298df1984a532833137706c04" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_map_blocks0", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.Sequence.Lemmas.f_shift", + "equation_Lib.Sequence.Lemmas.l_shift", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.map_blocks_a", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_eq_elim", + "lemma_FStar.Seq.Base.lemma_eq_refl", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7af7abfd9fa791df66706ab563886df2", + "refinement_interpretation_Tm_refine_b913a3f691ca99086652e0a655e72f17", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "refinement_interpretation_Tm_refine_f571f2610f867b24665eec96f119e18c", + "token_correspondence_Lib.Sequence.Lemmas.f_shift", + "token_correspondence_Lib.Sequence.Lemmas.l_shift", + "typing_FStar.Seq.Base.empty", "typing_Lib.Sequence.length" + ], + 0, + "11016614432ef13a6d27d122200c7bce" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_map_blocks0", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "22c601c2f6642877c43d1cbc3764fe58" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_is_empty", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7ad90407dad3095183eb4d692b62fd08" + ], + 0, + "9ab3ae00a867717efd488d44c17376ca" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_is_empty", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.Sequence_interpretation_Tm_arrow_d3b9c37343cabe37d3e11c0a1cafa7da", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.map_blocks_a", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Properties.slice_is_empty", + "lemma_FStar.Seq.Properties.slice_length", + "primitive_Prims.op_Division", "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7ad90407dad3095183eb4d692b62fd08", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_b361ba8089a6e963921008d537e799a1", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_Lib.Sequence.length", "typing_Lib.Sequence.map_blocks_multi" + ], + 0, + "baea6a63914b51fb81763edb944cd18b" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_is_empty", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "0355a40e31ba55c41033a3106bb52411" + ] + ] +] \ No newline at end of file diff --git a/tests/hacl/Lib.Sequence.Lemmas.fsti.hints b/tests/hacl/Lib.Sequence.Lemmas.fsti.hints new file mode 100644 index 00000000000..fe2b763cecb --- /dev/null +++ b/tests/hacl/Lib.Sequence.Lemmas.fsti.hints @@ -0,0 +1,860 @@ +[ + "þ#RÇ•Òðr»S¸Ø\u0015}Ø\u0018", + [ + [ + "Lib.Sequence.Lemmas.get_block_s", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3833667c59aecdf581ef615fb6194b08", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_ade7773d9cd7cd1a2abc2fe3f191b9e0", + "refinement_interpretation_Tm_refine_c37230a0b45bfa733513e4ce89ef34d6", + "typing_FStar.Seq.Base.length" + ], + 0, + "13e00680463992ec2698283148a06dbf" + ], + [ + "Lib.Sequence.Lemmas.get_block_s", + 2, + 0, + 0, + [ "@query" ], + 0, + "ae9abfd53e327e1e3f7ad6fc0ae68e10" + ], + [ + "Lib.Sequence.Lemmas.get_last_s", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3833667c59aecdf581ef615fb6194b08", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "typing_FStar.Seq.Base.length" + ], + 0, + "563f38db8e255a24a36e4667f6cb3c8e" + ], + [ + "Lib.Sequence.Lemmas.repeat_right_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_12aaa86fce4296e5ca537def690c90b7", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "refinement_interpretation_Tm_refine_fd19feb5f9ea77c43306cb5b7a87bc36" + ], + 0, + "bb04fc4ae901d31b8cd72c5a0d8f962d" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_right_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c521dec61896a844c454ea9692ebf2e2", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2" + ], + 0, + "7e40a6d6d1ea10bd2567db62987154a7" + ], + [ + "Lib.Sequence.Lemmas.repeati_right_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "c1aac410cd098b1d9e2e5fac899a6574" + ], + [ + "Lib.Sequence.Lemmas.repeati_right_shift", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "e570a0aa12b95699730ebe6d33338256" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_f", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_bbe86a0a6209b8c07083cd4c9f7f9aa5", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.length" + ], + 0, + "7f9be82ee9ac50a84002cce5cad2d6ea" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_f", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "c1776ed03a0bae560c597f041338e8c2" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "8fe207a80f35c4cdbee51d492220811a" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_gen_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "ed72c52d956488c64fca0c52aae0e8e8" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "2a92d386bdaa69387631b8507f746b51" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_gen_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_FStar.Seq.Base.length", "typing_Lib.Sequence.length" + ], + 0, + "1295131ceedbfaf2db2482ffdab80ba5" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_extensionality_zero", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "l_quant_interp_e0c135c0d1d2d760fb7f155318d559d0", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_46d0490fc1bcee17b1822abbbaec9be9", + "refinement_interpretation_Tm_refine_4a1f484c8b51af7634bbc9267ad1b558", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "50c5af1f7f1feffa5d4d67ad8ef5f5e6" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_extensionality_zero", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_46d0490fc1bcee17b1822abbbaec9be9", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_667c0deceb286bd669e5316a684eee1c", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c8d0b9c0d9bab47c0f00a15221dd05c4" + ], + 0, + "4e9b039dde0bff212fecf72027a7ba4a" + ], + [ + "Lib.Sequence.Lemmas.len0_div_bs", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "3f1019a2577d09c55e445926eb2ea0bd" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "8b9be73e42075a05e5aeed05e22f693e" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "deae0656b4bc40fb1593e45ad0c77138" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_split", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_24813cd65ccef7cf8c09228ba9bdbf64", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "8b8a8f75c9ef1a4c485a37d5de0e36ee" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_split", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_fcf14b481b3a84f47b67fc1dd0096ca5", + "typing_Lib.Sequence.length" + ], + 0, + "299bf3092005cf34f257c0b059a1fd7c" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "739766b9133dec918e1e579b95473738" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_blocks_via_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "typing_FStar.Seq.Base.length", "typing_Lib.Sequence.length" + ], + 0, + "f317d4255a73206b88bcdea744329f0d" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_is_repeat_gen_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_dc64ef62fd3101207c953516420ca99f", + "typing_Lib.Sequence.length" + ], + 0, + "02633b72191870fd702d768740c9e69e" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_is_repeat_gen_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_f571f2610f867b24665eec96f119e18c" + ], + 0, + "28b963a0b3363e652c1bc07d6377f43c" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_split", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_5e9c3dad358c3890f342f5eeb42bb76e", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "typing_Lib.Sequence.length" + ], + 0, + "16f8b44d23a9eb3cd9d11a33815485f5" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_split", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_725406258cbec7cb7a61bee1d844d771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647" + ], + 0, + "83130f3d208a299b3d000f03920544b4" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "74a86cf7de72dee199162971bb569382" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "5450b51bf6853c3f0a4be5ab0cb04747" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Division", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "eeddae13bf985c6ba3535c8cf489526c" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.Sequence_interpretation_Tm_arrow_d3b9c37343cabe37d3e11c0a1cafa7da", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.append", "typing_FStar.Seq.Base.length" + ], + 0, + "fbc159dc983edb8474a64b8674b7e0fe" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "b367aa27c4d33121d8f40ca93af8ff62" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "1fd71e464c5faa8be2b1f8e3b2c921a8" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_l_length", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "d4a831a7f9c60192301c2270afd6243f" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "475573dca129be53e4e0783d6de8e552" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "6da6f20a43cf9f77df44981d12b38c3e" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_length", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "7f72253583a113c037b8e1db5755bdce" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_repeat_gen_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "eb79dfb9fce1ed0c977f41713b901645" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_repeat_gen_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "b72a8d8ccb98d10821cf6f7fbe36d21c" + ], + [ + "Lib.Sequence.Lemmas.f_shift", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "1ce873152945e25b2e83bfc05aaee18a" + ], + [ + "Lib.Sequence.Lemmas.f_shift", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "1c2863a0199dc24cbcae8fd9fea96e9e" + ], + [ + "Lib.Sequence.Lemmas.l_shift", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d" + ], + 0, + "41e097cedf3a3ba276090ba736d585a8" + ], + [ + "Lib.Sequence.Lemmas.l_shift", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213" + ], + 0, + "cc0aa97b8eb4d792ddacffa427d5cc14" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "d5b4e5521102e65ed28ccbab59a44b32" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_map_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "bbf49aff4b3e76ee88141df6b2e15c05" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi0", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d" + ], + 0, + "f57047f3e988646fa492d09cc5549306" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_map_blocks0", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_f571f2610f867b24665eec96f119e18c" + ], + 0, + "eeff17beba3e966bef49b53eb1a5b399" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_is_empty", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7ad90407dad3095183eb4d692b62fd08" + ], + 0, + "d26c68bfdca0bbc0c5ccffa9438617cb" + ] + ] +] \ No newline at end of file diff --git a/tests/hacl/Lib.Sequence.fsti.hints b/tests/hacl/Lib.Sequence.fsti.hints new file mode 100644 index 00000000000..224c84cd3d6 --- /dev/null +++ b/tests/hacl/Lib.Sequence.fsti.hints @@ -0,0 +1,976 @@ +[ + "qÂÑŸQ;ì5´í¿\u0002#\u001c", + [ + [ + "Lib.Sequence.to_lseq", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "refinement_interpretation_Tm_refine_d6b65d48a86d318eee5320e9fc07ce57" + ], + 0, + "2bac857ac5a7372c8405cc1190964648" + ], + [ + "Lib.Sequence.index", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.to_seq", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "442a47789488265e1263b0b076187d40" + ], + [ + "Lib.Sequence.create", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4" + ], + 0, + "a3808336cf0ec7916c8a2f369a07d750" + ], + [ + "Lib.Sequence.concat", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_485bc5b41c309040098b0ab067e4ac2c", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4" + ], + 0, + "4afa2a373a8d742c1bdfd965e390c809" + ], + [ + "Lib.Sequence.to_list", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.eqtype", + "equation_Prims.nat", "function_token_typing_Prims.int", + "haseqTm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f" + ], + 0, + "ca10ad20e7f2b04ea59b7666fc762c7e" + ], + [ + "Lib.Sequence.of_list", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_56609cb097df748006aafa90a98ed73d" + ], + 0, + "904e0c6bb89c5e661005e0889fa0a2f6" + ], + [ + "Lib.Sequence.of_list_index", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_56609cb097df748006aafa90a98ed73d" + ], + 0, + "93354fdbc85d0cf489337f8b0f42e17d" + ], + [ + "Lib.Sequence.eq_intro", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.to_seq", + "refinement_interpretation_Tm_refine_6b8a1e6e39c8fbea3860e8d70e3dfbd5", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "41b4af4c67a9666725ff2eabe6ac300e" + ], + [ + "Lib.Sequence.upd", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.to_seq", "equation_Prims.eqtype", + "equation_Prims.nat", "function_token_typing_Prims.int", + "haseqTm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_dee0f34b44c44e6d512c6db0858b92ef" + ], + 0, + "c7e937ac02dafd7565823fd0fd99ff83" + ], + [ + "Lib.Sequence.sub", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.to_seq", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_LessThanOrEqual", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_b9bf9d0f857340a8d758087374a41c06", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "ff71ff779377c165a95b2a073479e97c" + ], + [ + "Lib.Sequence.slice", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4", + "refinement_interpretation_Tm_refine_e5df7b46d8b4d6787f7fc44dbc0015e5" + ], + 0, + "c3de20185f217385814401ddf46c49ac" + ], + [ + "Lib.Sequence.update_sub", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.to_seq", "equation_Prims.nat", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0b72b617030921a422a8020811c2f320", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_b9bf9d0f857340a8d758087374a41c06", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "0f5bafcd6d8a2b40c0154bd713af0a59" + ], + [ + "Lib.Sequence.lemma_update_sub", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.to_seq", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_03ea481677aa4f241e0fcf866da3eab4", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_b9bf9d0f857340a8d758087374a41c06", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "b40302cf1eb4747e21f2e59f6736273e" + ], + [ + "Lib.Sequence.lemma_concat2", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_485bc5b41c309040098b0ab067e4ac2c", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4" + ], + 0, + "064dbbb03191ec1570eda18f611540d0" + ], + [ + "Lib.Sequence.lemma_concat3", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_485bc5b41c309040098b0ab067e4ac2c", + "refinement_interpretation_Tm_refine_4e798f335f6b4b1ff5946bd101912e0e", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4" + ], + 0, + "d382f70ae88453b6f33ef3ef884e6bd9" + ], + [ + "Lib.Sequence.update_slice", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4", + "refinement_interpretation_Tm_refine_e5df7b46d8b4d6787f7fc44dbc0015e5" + ], + 0, + "ba39be2fe3f62f2f8cdc05cb0aa24dab" + ], + [ + "Lib.Sequence.update_slice", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4", + "refinement_interpretation_Tm_refine_e5df7b46d8b4d6787f7fc44dbc0015e5" + ], + 0, + "13265bc261ea499fccc434ae9cd35e29" + ], + [ + "Lib.Sequence.createi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4" + ], + 0, + "fb301175cbb2de98c21a530bc3459b3b" + ], + [ + "Lib.Sequence.mapi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4" + ], + 0, + "75dcfef04d396d5a074a3e51524264e5" + ], + [ + "Lib.Sequence.map", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4" + ], + 0, + "fa8ba89969f8a16ccbc10e29674ddb19" + ], + [ + "Lib.Sequence.map2i", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4" + ], + 0, + "14ea14a41a1e4eb25f56120aa0bb734e" + ], + [ + "Lib.Sequence.map2", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4" + ], + 0, + "8281a1eb2962e5ea8e485fb1029dd171" + ], + [ + "Lib.Sequence.repeati_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "cf00864df9bb285ae96c3487bca04888" + ], + [ + "Lib.Sequence.repeat_blocks_f", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1c325641987cce6783228428bd15a869", + "refinement_interpretation_Tm_refine_1f6c16a51cd4ba3256b95ca590c832c5", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_aee8f5bc805e40f3cc22e281aedfc983", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_FStar.Seq.Base.length" + ], + 0, + "8240b5bc79513992265f1ca258d2917f" + ], + [ + "Lib.Sequence.repeat_blocks_f", + 2, + 0, + 0, + [ "@query" ], + 0, + "f5ded68723583efcb1681acc89e8d782" + ], + [ + "Lib.Sequence.repeat_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "5d8531912b0ddee93b6e4b956b37dcfe" + ], + [ + "Lib.Sequence.lemma_repeat_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "typing_FStar.Seq.Base.length", "typing_Lib.Sequence.length" + ], + 0, + "763ca86f510e52b9a21822ccb43b6b2f" + ], + [ + "Lib.Sequence.repeat_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "07156fa8f9cc8256e6d95fe08921dc5c" + ], + [ + "Lib.Sequence.lemma_repeat_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Division", "primitive_Prims.op_Modulus", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_b14928a18ba707004108386997fed9d6", + "typing_Lib.Sequence.length" + ], + 0, + "dd8ca49c8e160863520c666a4e6cc20d" + ], + [ + "Lib.Sequence.generate_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "b811f68bf7697dcbc05ee9acb05be10a" + ], + [ + "Lib.Sequence.generate_blocks_simple", + 1, + 0, + 0, + [ "@query" ], + 0, + "8a797ed4ec63b4b86f7f60b7ac534f23" + ], + [ + "Lib.Sequence.div_interval", + 1, + 0, + 0, + [ "@query" ], + 0, + "b295a61093bd8d9ee24975e082cb7e34" + ], + [ + "Lib.Sequence.mod_interval_lt", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "bb82a7af665340d7097a74696738b2df" + ], + [ + "Lib.Sequence.div_mul_lt", + 1, + 0, + 0, + [ "@query" ], + 0, + "11a97ab1fb1afb2fdb0e37db44384d98" + ], + [ + "Lib.Sequence.mod_div_lt", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "bc1b5dadd1c2b4e3a4b5dc48259d71e6" + ], + [ + "Lib.Sequence.div_mul_l", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "2565083250134e2fd111dedd7d34867b" + ], + [ + "Lib.Sequence.map_blocks_f", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Lib.Sequence.map_blocks_a", + "equation_Lib.Sequence.seq", "equation_Prims.nat", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_append", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1c325641987cce6783228428bd15a869", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_aee8f5bc805e40f3cc22e281aedfc983", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.length", "typing_Lib.Sequence.length" + ], + 0, + "74751c1395cb98e7e54c5ab08ee69ec1" + ], + [ + "Lib.Sequence.map_blocks_f", + 2, + 0, + 0, + [ "@query" ], + 0, + "7a6caf7afaf0c2e62c33ef1e1c0c54c1" + ], + [ + "Lib.Sequence.map_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "d7610110c0d11ed68ba454c8ee50a055" + ], + [ + "Lib.Sequence.lemma_map_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d" + ], + 0, + "bdf5d18e13cd3cc105d40283f5721c35" + ], + [ + "Lib.Sequence.index_map_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_07295705544891065e7a01d318c0ba51", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_ade7773d9cd7cd1a2abc2fe3f191b9e0", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.length" + ], + 0, + "b760e7bf50e21b7476ed29c7869dc461" + ], + [ + "Lib.Sequence.block", + 1, + 0, + 0, + [ "@query" ], + 0, + "9f73155752038a24a62521e0f3c4f194" + ], + [ + "Lib.Sequence.last", + 1, + 0, + 0, + [ "@query" ], + 0, + "3fe9338a10fd75d1be2fb7d3f4965d4b" + ], + [ + "Lib.Sequence.map_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "f36ed29a26183b7ec8a1ad687c44fe95" + ], + [ + "Lib.Sequence.lemma_map_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "typing_FStar.Seq.Base.length", "typing_Lib.Sequence.length" + ], + 0, + "9cc604190b356768e1d262a057b3e5e8" + ], + [ + "Lib.Sequence.get_block", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3833667c59aecdf581ef615fb6194b08", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_ade7773d9cd7cd1a2abc2fe3f191b9e0", + "refinement_interpretation_Tm_refine_c37230a0b45bfa733513e4ce89ef34d6" + ], + 0, + "dfa63ef52a79cfbdc21010bef30c06ba" + ], + [ + "Lib.Sequence.get_block", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "0c046086f3025259ac529b668b74bc67" + ], + [ + "Lib.Sequence.get_last", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3833667c59aecdf581ef615fb6194b08", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_eeb59caff9a959bab0eef3a399bf14b7" + ], + 0, + "f4d47c2449b05ed672499d25f959a6d1" + ], + [ + "Lib.Sequence.get_last", + 2, + 0, + 0, + [ "@query" ], + 0, + "f28c8b72c7a92ff7d17599ccdda232f4" + ], + [ + "Lib.Sequence.index_map_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_LessThan", + "primitive_Prims.op_Modulus", "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_824da4eabc6ac6d5c984b1ec60534f76", + "refinement_interpretation_Tm_refine_8710a3dcbb7aeecb1da33ddf8070b919", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_Lib.Sequence.map_blocks" + ], + 0, + "02489a82a1b3678b10ee0584c074b265" + ], + [ + "Lib.Sequence.eq_generate_blocks0", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "2067c8e5f38977a94836b1891a591cb9" + ], + [ + "Lib.Sequence.unfold_generate_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3833667c59aecdf581ef615fb6194b08", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.append", "typing_FStar.Seq.Base.length" + ], + 0, + "696c3f5df635d6e78d2dba3290ac6a3e" + ], + [ + "Lib.Sequence.index_generate_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Division", "primitive_Prims.op_Modulus", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_07295705544891065e7a01d318c0ba51", + "refinement_interpretation_Tm_refine_3833667c59aecdf581ef615fb6194b08", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "unit_typing" + ], + 0, + "21d0ea0cec031e9df0cb97cb01f6ebea" + ], + [ + "Lib.Sequence.create2", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "89877ecd7602cfc9ae76b2a83402a5f4" + ], + [ + "Lib.Sequence.create2_lemma", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "8d532ab8710c1758fe0d13720e195041" + ], + [ + "Lib.Sequence.create4", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "3e67a09905e5c5b05c022cdb18904d55" + ], + [ + "Lib.Sequence.create4_lemma", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "037e2086b946ae7163bbda9d1fd31429" + ], + [ + "Lib.Sequence.create8", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "b1a833dcadf40531370d93645b8cc579" + ], + [ + "Lib.Sequence.create8_lemma", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "73e3b2f28d4eb9f6d84c16a8c59bb4e4" + ], + [ + "Lib.Sequence.create16", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "7e665e042f0a395b190d0bb621235afd" + ], + [ + "Lib.Sequence.create16_lemma", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "ebbe927cbedf762618d923f98667d742" + ], + [ + "Lib.Sequence.create32", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "cc72d4fd028084920598d625968c6459" + ], + [ + "Lib.Sequence.create32_lemma", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "1a8f9fe1039a997faa7871f42cce4349" + ] + ] +] \ No newline at end of file diff --git a/tests/hacl/Lib.Vec.Lemmas.fst.hints b/tests/hacl/Lib.Vec.Lemmas.fst.hints new file mode 100644 index 00000000000..c3ffaa345a1 --- /dev/null +++ b/tests/hacl/Lib.Vec.Lemmas.fst.hints @@ -0,0 +1,2294 @@ +[ + "ó$×¼±ÞmtQ\r*Çn\u001c¬’", + [ + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6f77474ede8199333d3f4de9c694b4b9", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "5a1411901d69495451bed2316b99cc7e" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_vec", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_3", + "binder_x_f26957a7e62b271a8736230b1e9c83c1_2", "equation_Prims.nat", + "equation_Prims.pos", + "function_token_typing_Prims.__cache_version_number__", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_214521be6835548f2f282adfe2372d8b", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_a3655d6698d33f820804a971c83ae369", + "refinement_interpretation_Tm_refine_aacd5c5013e5b4b181bda5c667bdb087", + "well-founded-ordering-on-nat" + ], + 0, + "26aa968e05cfbd1966c482b37f00e455" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_vec", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6f77474ede8199333d3f4de9c694b4b9", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "8f250d0ada553a77ac3a92eedc8f5014" + ], + [ + "Lib.Vec.Lemmas.lemma_repeati_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "28a410c23c5f5e2173e048f42167a378" + ], + [ + "Lib.Vec.Lemmas.lemma_repeati_vec", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.fixed_i", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "token_correspondence_Lib.LoopCombinators.fixed_i" + ], + 0, + "8365d442ccdb3c46af2a44e764960aa3" + ], + [ + "Lib.Vec.Lemmas.len_is_w_n_blocksize", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "a69c31cff994a6ad4fe2fd8f8094fe2c" + ], + [ + "Lib.Vec.Lemmas.len_is_w_n_blocksize", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "7a21b21fbd0677a7ed1ddf32c31bfce0" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_Prims.pow2" + ], + 0, + "c4df913dab06b77e3a39c21a29055dc5" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "c087f34c5dd7c857bdcc125d5fdb0268" + ], + [ + "Lib.Vec.Lemmas.get_block_v", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "8af9da7e87b17b77e11af66405f7f954" + ], + [ + "Lib.Vec.Lemmas.get_block_v", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_8d6fa9117891ba071496ffc959fc4d4b", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_FStar.Seq.Base.length" + ], + 0, + "edf8e364c3edc26d28028ae578de0cf2" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_slice_k", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_096438f6bdfa8da57c0b90fb63f06bdb", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_2c0568e51630566768dea977a21880bf", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d6b1a92117d4cdff80313427385685c8", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "1ed848236ef81eb646ef8a6be5d65f37" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_slice_k", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_f", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.seq", "equation_Lib.Vec.Lemmas.get_block_v", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Minus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_2c0568e51630566768dea977a21880bf", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c302f51ce94a5d85770dea0d10e6ef86", + "refinement_interpretation_Tm_refine_d6b1a92117d4cdff80313427385685c8", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "a5fdc5e4c9f8d4949255f562db7d98aa" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_slice_k", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_2c0568e51630566768dea977a21880bf", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d6b1a92117d4cdff80313427385685c8" + ], + 0, + "f60afe613f58bdfe9ac8df5dc31ce3a6" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_slice", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_096438f6bdfa8da57c0b90fb63f06bdb", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_2c0568e51630566768dea977a21880bf", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d6b1a92117d4cdff80313427385685c8", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "52c51b19005d4de45abf1c41efea16ac" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_slice", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_096438f6bdfa8da57c0b90fb63f06bdb", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_2c0568e51630566768dea977a21880bf", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_d6b1a92117d4cdff80313427385685c8", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "d76a932b0ced194f5eedfd0c3ed4b9a7" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_slice", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d6b1a92117d4cdff80313427385685c8" + ], + 0, + "182477006ed232078ef878ba0b711c5c" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_step", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_096438f6bdfa8da57c0b90fb63f06bdb", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_ba24c249c2bac9c9652dccf45aee8033", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "ec5b31d38ce0f498a02ec66c33b67e9d" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_step", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "eq2-interp", "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_f", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.seq", "equation_Lib.Vec.Lemmas.get_block_v", + "equation_Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_equiv_pre", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_096438f6bdfa8da57c0b90fb63f06bdb", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_2c0568e51630566768dea977a21880bf", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6a886eba44118bdd83730df8832311a9", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_Lib.Sequence.length" + ], + 0, + "9ccbe5460cc49aed5ca3a2a531b01390" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_step", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "d2d8db6ebe1fe72e614176579aad88d2" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_blocks_multi_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "1e5e30b978c3cd02483cf8124ba08c06" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_blocks_multi_vec", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_096438f6bdfa8da57c0b90fb63f06bdb", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_5507b02af25b553b133f7efccc558bb5", + "refinement_interpretation_Tm_refine_6f77474ede8199333d3f4de9c694b4b9", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_ba24c249c2bac9c9652dccf45aee8033", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "992c9e22bb93b52650490663e1c2318a" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_blocks_multi_vec", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "9caaa9eb73e27c6d7af50d6172455713" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "f49b08fa0e9b1b7cf01adc574b4f69ee" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1140254f0add9ac82e3c74c399912e35", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d" + ], + 0, + "2eb867bd66f1669a3b233f864d96d1c7" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_blocks_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1140254f0add9ac82e3c74c399912e35", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_4e46b18e6de7fd724da2ef45eb7b3ba2", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "276aab274eb68f5f379416487602719c" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_blocks_vec", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "eq2-interp", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Lib.Sequence.seq", + "equation_Lib.Vec.Lemmas.repeat_gen_blocks_vec_equiv_pre", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_4e46b18e6de7fd724da2ef45eb7b3ba2", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "typing_FStar.Seq.Base.slice", "typing_Lib.Sequence.length" + ], + 0, + "47d8d620a5fb98787d2b3ddba3690ac1" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_blocks_vec", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1140254f0add9ac82e3c74c399912e35", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_4e46b18e6de7fd724da2ef45eb7b3ba2", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "874c7b64061a87d8c8ea80de970d23da" + ], + [ + "Lib.Vec.Lemmas.repeat_blocks_multi_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "6229dccdc0c82f8df117e5f98d6a4d9c" + ], + [ + "Lib.Vec.Lemmas.repeat_blocks_multi_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "6f20ba4aa3670a52c28771e6ba75fd37" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_multi_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_FStar.Seq.Base.length" + ], + 0, + "cd295d03cd0a34287bafebcdc932ec53" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_multi_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "eq2-interp", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.fixed_i", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Vec.Lemmas.repeat_blocks_multi_vec_equiv_pre", + "equation_Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_equiv_pre", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d6e5c35ff3aad90541fc8f7abd9ac6d4", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "token_correspondence_Lib.LoopCombinators.fixed_i" + ], + 0, + "bc12d05fd9021c657c4b5c5040c02e40" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_multi_vec_equiv_pre", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "d25788183a30bca2fb7cbb52c972a387" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_multi_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e90c2c89afe31ba2752cabd31cd7f6e7" + ], + 0, + "40af2355a681ad376ed8dab39471be3c" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_multi_vec", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.fixed_i", + "equation_Lib.Sequence.length", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e90c2c89afe31ba2752cabd31cd7f6e7", + "token_correspondence_Lib.LoopCombinators.fixed_i", + "typing_Lib.Sequence.length" + ], + 0, + "a5005d08fd00bc230ef8cfce941dc4a9" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_multi_vec", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e90c2c89afe31ba2752cabd31cd7f6e7" + ], + 0, + "8273ff4de465a0b49b6e81a3323d6045" + ], + [ + "Lib.Vec.Lemmas.repeat_blocks_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "a62603edb54c59fe49b91cf8d63a07be" + ], + [ + "Lib.Vec.Lemmas.repeat_blocks_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "6733b74c4434a9f017159df4aa16b9b5" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "08075c4b5c49f27231a598d0018aa47b" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "eq2-interp", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.fixed_i", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Vec.Lemmas.repeat_blocks_vec_equiv_pre", + "equation_Lib.Vec.Lemmas.repeat_gen_blocks_vec_equiv_pre", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_b2d3f317f91f417bcb8a5847865e4675", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "token_correspondence_Lib.LoopCombinators.fixed_i" + ], + 0, + "b91850b7b96fcc397f6d8db384baaba1" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_vec_equiv_pre", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "5ca834d299de40ed2e994763b5ccc626" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "9531d1a024411314681981abc9c7bd7d" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_vec", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.fixed_i", + "equation_Lib.Sequence.length", "equation_Prims.nat", + "equation_Prims.pos", + "function_token_typing_Lib.LoopCombinators.fixed_a", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "token_correspondence_Lib.LoopCombinators.fixed_i", + "typing_Lib.Sequence.length" + ], + 0, + "d6b72d6b1201349f5e84debe37396309" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_vec", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "2223afd188e7c6d3d9d9f9e621d9aa7e" + ], + [ + "Lib.Vec.Lemmas.lemma_f_map_ind", + 1, + 0, + 0, + [ "@query" ], + 0, + "94c7bfa95c648d627c1508d1a3c752c9" + ], + [ + "Lib.Vec.Lemmas.lemma_f_map_ind", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "e40a255851d21cabd22e259ca6e8c3d7" + ], + [ + "Lib.Vec.Lemmas.map_blocks_multi_vec_equiv_pre_k", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_6ee4cce4172b405aefb288f98b829040", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "70a26ac0d7ccf01051ad26ba5d3c3717" + ], + [ + "Lib.Vec.Lemmas.map_blocks_multi_vec_equiv_pre_k", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "a33605d68fbd6adc580e16849dfddf72" + ], + [ + "Lib.Vec.Lemmas.normalize_v_map", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d" + ], + 0, + "2d88fb4a31cac2c5b3564d6413bbf4a9" + ], + [ + "Lib.Vec.Lemmas.normalize_v_map", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d" + ], + 0, + "3963215ccc9376e4068d9816d8ef9acc" + ], + [ + "Lib.Vec.Lemmas.normalize_v_map", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "976239fcc2a1dad097a3dcb5ac2d242a" + ], + [ + "Lib.Vec.Lemmas.map_blocks_multi_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_6ee4cce4172b405aefb288f98b829040", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803" + ], + 0, + "e40d79c25e776cc5c3c68f846be1edb5" + ], + [ + "Lib.Vec.Lemmas.map_blocks_multi_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "2adf5a9ef78f5da7d494c5ec6dcbe3eb" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec_equiv_pre_k", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "dcdfe7fa9b4ddaf415a6eb8cab198f97" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec_equiv_pre_k", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_6ee4cce4172b405aefb288f98b829040", + "eq2-interp", "equation_Lib.Sequence.Lemmas.f_shift", + "equation_Lib.Sequence.Lemmas.get_block_s", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Lib.Vec.Lemmas.map_blocks_multi_vec_equiv_pre", + "equation_Lib.Vec.Lemmas.map_blocks_multi_vec_equiv_pre_k", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_eq_elim", + "lemma_FStar.Seq.Base.lemma_eq_refl", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_25699f4de0c949c68e992e5573c8bf6d", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_648962b2ae132d6b66f0e1687b18875e", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_9c15d596f5953eb9d8aa8805ac0915cc", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "token_correspondence_Lib.Sequence.Lemmas.f_shift", + "typing_FStar.Seq.Base.length" + ], + 0, + "9c4d8fb4287415af3a42b31d99c645fa" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec_equiv_pre_k", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "88986cbcd49267496cff5a82681f8941" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_FStar.Seq.Base.length" + ], + 0, + "08a2efba74abf116222ea02529686b4f" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "Lib.Sequence_interpretation_Tm_arrow_d3b9c37343cabe37d3e11c0a1cafa7da", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_2b8b111ba83aebf8b7d238de5c60949e", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_6ee4cce4172b405aefb288f98b829040", + "eq2-interp", "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Lib.Vec.Lemmas.map_blocks_multi_vec_equiv_pre", + "equation_Lib.Vec.Lemmas.normalize_v_map", + "equation_Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_equiv_pre", + "equation_Prims.nat", "equation_Prims.pos", + "function_token_typing_Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + "function_token_typing_Lib.Vec.Lemmas.normalize_v_map", + "int_inversion", "int_typing", "lemma_FStar.Seq.Base.lemma_eq_elim", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_25699f4de0c949c68e992e5573c8bf6d", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_8fb87dad301251f52db6827c1feade3d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "token_correspondence_Lib.Vec.Lemmas.normalize_v_map", + "typing_FStar.Seq.Base.append", + "typing_Lib.Sequence.Lemmas.map_blocks_multi_acc", + "typing_Lib.Sequence.Lemmas.repeat_gen_blocks_map_f" + ], + 0, + "a17b6f5974d5b43a3b7a66cb406ac8d2" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec_equiv_pre", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "c8a4d529b29b85d03dfb7a242baab5b9" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "typing_Lib.Sequence.length" + ], + 0, + "92dc7d196ed6318e8478f1e5bbaffa15" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Lib.Vec.Lemmas.normalize_v_map", "equation_Prims.nat", + "equation_Prims.pos", + "function_token_typing_Lib.Sequence.map_blocks_a", "int_inversion", + "lemma_FStar.Seq.Base.lemma_eq_elim", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_361ceade980020b5c15ebf36d114dc78", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_b913a3f691ca99086652e0a655e72f17", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "refinement_interpretation_Tm_refine_f91d1a7dd6f8b240a8d009f0cf4aae51", + "typing_FStar.Seq.Base.empty" + ], + 0, + "8200f6ce17fc1f1af854463765cd6a04" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "6885ef4baf575c193b2a595ec2f62762" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa" + ], + 0, + "43d1117b1837c606f12d6666997795eb" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "8a816aba54c2387eed3a7e5816ae004d" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 4, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa" + ], + 0, + "3b71f1375d444e4ea4d6f5502252322a" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 5, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa" + ], + 0, + "5401813315e15c3aa43efa49cb1f88a0" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 6, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "b9d750e9c257f1a36df966dfc4583927" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 7, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "000cdaf83e980669d9c54d15ac2c28e1" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 8, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "refinement_interpretation_Tm_refine_ab6c278100f153565df5228daa4ed476" + ], + 0, + "6fc39bd33bab0528bb0cf272a1625010" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 9, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", + "primitive_Prims.op_LessThan", "primitive_Prims.op_Multiply", + "projection_inverse_BoxBool_proj_0", + "refinement_interpretation_Tm_refine_a785938b699e90fce488019a1aefd3e0", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_dbc690734b1a4717a95b7b47d8b25381" + ], + 0, + "c38af278395043941f328746bbaaf54b" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 10, + 0, + 0, + [ "@query" ], + 0, + "047ef4c0ba4a8c1a823cf09a4f560c64" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 11, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "refinement_interpretation_Tm_refine_9b7f7323a9f8dfb00b51e7329ba0abbe", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "f8151f0c90627b4ff6b2f24ad6cfd5fb" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 12, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6fdcf7302a39aeac615b0eb19b068938", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c1ab57b24250edc055de8723758a2507", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "c8b5d9a0b7166585218efccb9ed7591e" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 13, + 0, + 0, + [ + "@query", "b2t_def", "primitive_Prims.op_Addition", + "primitive_Prims.op_LessThan", "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0" + ], + 0, + "56645d670fc1d17efcc68146852d5451" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 14, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa" + ], + 0, + "7c253127502bc4cdc4a0d96f2df6bbf0" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 15, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Modulus", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "a141dce35a15980af5d57516f19e479a" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 16, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "equation_Prims.pos", "primitive_Prims.op_Modulus", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_36069b0a8365444db28aacdd020d9773", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "2ad0879e7b80c277524ea7eba32a874d" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 17, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa" + ], + 0, + "ad76bdec689f1caa7673a68c7fbd283d" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 18, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Modulus", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "ed830ecd717cc71e262532e56a27a8fb" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 19, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "e1b02e511005d7247033bd9b8e7c1190" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 20, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "413ceb4379e687ca87b424a26a76473f" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 21, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "refinement_interpretation_Tm_refine_ab6c278100f153565df5228daa4ed476" + ], + 0, + "2c230008712e5a670000c70f8e5a7128" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 22, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "primitive_Prims.op_LessThan", + "primitive_Prims.op_Multiply", + "refinement_interpretation_Tm_refine_0821e24547a8d1dcfc53e49b580fdc23" + ], + 0, + "e6896017f4add71c2fdbae994bf3b05f" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 23, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "1a3e96668c0ce02724bf6cd627c5b636" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 24, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa" + ], + 0, + "f2784fad8d0dfc8f93a7748702e0c67d" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 25, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa" + ], + 0, + "4e48fa70b66c45bef839b4095a1f9dcb" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 26, + 0, + 0, + [ + "@query", "b2t_def", "primitive_Prims.op_LessThan", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "323ff069a8336e08490be39c0ba768d8" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 27, + 0, + 0, + [ "@query" ], + 0, + "bfbc627413aa9fa71b68bbc8406c3fcc" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 28, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "refinement_interpretation_Tm_refine_9b7f7323a9f8dfb00b51e7329ba0abbe", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "5172b2ee83a81bba20361515fee33b7d" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 29, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", + "equation_Lib.Sequence.lseq", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThan", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0821e24547a8d1dcfc53e49b580fdc23", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6fdcf7302a39aeac615b0eb19b068938", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c1ab57b24250edc055de8723758a2507", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "a3000e8e696412322732237cce758021" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 30, + 0, + 0, + [ + "@query", "b2t_def", "primitive_Prims.op_Addition", + "primitive_Prims.op_LessThan", "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0" + ], + 0, + "986cac0d6c2e2b4ba4eb1e4a2ed0cc5a" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 31, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa" + ], + 0, + "dfbfbc59f4629e5a832e4bdcc968de92" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 32, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Modulus", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "8ce8b7f9429fce93d49c1cd13b03207d" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 33, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Modulus", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "37838f12d22ab37692cb41ad1002f088" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 34, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa" + ], + 0, + "642cd07fd45f8082c633a9180f55492a" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 35, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "primitive_Prims.op_Modulus", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_611a250d766b5c9d1ddba7e33fccca95", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "75c4405636b36350e4eb80c77892752a" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 36, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", + "equation_Lib.Sequence.lseq", "primitive_Prims.op_LessThan", + "primitive_Prims.op_Modulus", "projection_inverse_BoxBool_proj_0", + "refinement_interpretation_Tm_refine_b013f9d695dd5b8ec28f09b7a3cfcb3c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "0d103bd0e56a0f9bdc6c29d4ced52031" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 37, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "e2a8ae361779f8945313c102a16927f2" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Lib.Sequence.map_blocks_a", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803" + ], + 0, + "84066a6cd407aca176545c8a70d67312" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "c512d33eb332f09e03ffdf0492b05fde" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre_k_aux", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8710a3dcbb7aeecb1da33ddf8070b919", + "refinement_interpretation_Tm_refine_bb0b8197bb42e9a1aaebe59e97685233", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "520dbf47b0c1787182a6313f1c9b4d4e" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre_k_aux", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "eq2-interp", "equation_Lib.Sequence.Lemmas.f_shift", + "equation_Lib.Sequence.Lemmas.get_block_s", + "equation_Lib.Sequence.Lemmas.get_last_s", + "equation_Lib.Sequence.Lemmas.l_shift", + "equation_Lib.Sequence.get_block", "equation_Lib.Sequence.get_last", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThan", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8710a3dcbb7aeecb1da33ddf8070b919", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "refinement_interpretation_Tm_refine_fe0ca3f3b25cc9d377244449d02c257b", + "token_correspondence_Lib.Sequence.Lemmas.f_shift", + "token_correspondence_Lib.Sequence.Lemmas.l_shift" + ], + 0, + "e4ee64e60574501882723ffa00a348dc" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre_k_aux", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "4392e0a88e4760d617b676d59b94a9c7" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre_k", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "02e6c1c4e29cc107c2b9c2d39f0ca767" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre_k", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Lib.Vec.Lemmas.map_blocks_vec_equiv_pre", + "equation_Prims.nat", "equation_Prims.pos", + "function_token_typing_Prims.__cache_version_number__", + "int_inversion", "lemma_FStar.Seq.Base.lemma_eq_elim", + "lemma_FStar.Seq.Base.lemma_eq_refl", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Equality", + "primitive_Prims.op_GreaterThan", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1e8892e6e831382419ad3b591eb7d098", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8710a3dcbb7aeecb1da33ddf8070b919", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "refinement_interpretation_Tm_refine_fe0ca3f3b25cc9d377244449d02c257b" + ], + 0, + "0e894a488317cafada75bcf71360d58b" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre_k", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "aca69830d4f8bccfb831c6f147a387b1" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "1a95a0b0c54a12be3d407b437584f7e8" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "f765ad15da6b80bc93cc9389caf47b4f" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 4, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "3e8612b27df199e8288f90a0d80940c8" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 5, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_90b5d2df39645a4835173a203da069e4" + ], + 0, + "3e5f71abe8eddf09ddf5188f6881b22b" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 6, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "03f2e35aa8c03309753610a90adb60c3" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 7, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "5254c4becc34805f2b6f6619d9ce433a" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 8, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "a4767dec603fad69b17341471a52f5ba" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 9, + 0, + 0, + [ + "@query", "b2t_def", "primitive_Prims.op_GreaterThanOrEqual", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "5a803c4ae22d6f6d407d7b104748a693" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 10, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", "equation_Prims.pos", + "primitive_Prims.op_Addition", + "primitive_Prims.op_GreaterThanOrEqual", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "cf517f574a790339ecd1e167d0501081" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 11, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_ab6c278100f153565df5228daa4ed476", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "90c41881dcd9265b62d19db2e6c93883" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 12, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_2b8b111ba83aebf8b7d238de5c60949e", + "equation_Lib.Sequence.map_blocks_a", + "equation_Lib.Vec.Lemmas.normalize_v_map", "equation_Prims.nat", + "equation_Prims.pos", + "function_token_typing_Lib.Vec.Lemmas.normalize_v_map", + "int_inversion", "primitive_Prims.op_Multiply", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "token_correspondence_Lib.Vec.Lemmas.normalize_v_map" + ], + 0, + "93ef73ed448ca1f3b73efe140d320cc1" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 13, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_9dbede814c7e09cf989d879ebca4b33a", + "Lib.Sequence_interpretation_Tm_arrow_d3b9c37343cabe37d3e11c0a1cafa7da", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_118c184bc6b09ad53ce4ad8d5a429a26", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_14de8c4f182c06de8d54fe736be97e51", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_2b8b111ba83aebf8b7d238de5c60949e", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_c38a40c75e862a598ad8a42d5d6e0b77", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_e8b984cc954d1a93c0670e47bfd79ffd", + "eq2-interp", "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Lib.Vec.Lemmas.map_blocks_vec_equiv_pre", + "equation_Lib.Vec.Lemmas.normalize_v_map", + "equation_Lib.Vec.Lemmas.repeat_gen_blocks_vec_equiv_pre", + "equation_Prims.nat", "equation_Prims.pos", "equation_Prims.prop", + "equation_Prims.subtype_of", + "function_token_typing_Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + "function_token_typing_Lib.Sequence.map_blocks_a", + "function_token_typing_Lib.Vec.Lemmas.normalize_v_map", + "int_inversion", "lemma_FStar.Seq.Base.lemma_eq_elim", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_1140254f0add9ac82e3c74c399912e35", + "refinement_interpretation_Tm_refine_135aa34345be03950a1f68856adc9696", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_468e2c12fe9f35171b9906080ca0a4e2", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_699b49b4417ef75b53fcedc14a52a1b7", + "refinement_interpretation_Tm_refine_73f210ca6e0061ed4a3150f69b8f33bf", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "refinement_interpretation_Tm_refine_90b5d2df39645a4835173a203da069e4", + "refinement_interpretation_Tm_refine_ab10ebde35f525273208b7b927d2f7d9", + "refinement_interpretation_Tm_refine_abadd9912c483da57a30d7d5a8a5f57c", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c4c06bc9798b4dacf79609445c9d1c09", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "token_correspondence_Lib.Sequence.map_blocks_a", + "token_correspondence_Lib.Vec.Lemmas.normalize_v_map", + "typing_FStar.Seq.Base.append", + "typing_Lib.Sequence.Lemmas.map_blocks_acc", + "typing_Lib.Vec.Lemmas.map_blocks_vec_equiv_pre", "unit_inversion" + ], + 0, + "00aeede63c7deebc17bb967118cfb199" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 14, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "44136ca1b1fc6387f0b147039f94cbe5" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_4e46b18e6de7fd724da2ef45eb7b3ba2", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "e3c9de38d29ee73b3bb24576997050a4" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec", + 2, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_9dbede814c7e09cf989d879ebca4b33a", + "Lib.Sequence_interpretation_Tm_arrow_d3b9c37343cabe37d3e11c0a1cafa7da", + "Lib.Sequence_interpretation_Tm_arrow_efd714987712642bce73b6a439af3d22", + "Lib.Sequence_interpretation_Tm_arrow_f67e6b48b3d5d38ee7701f3b137f9030", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_118c184bc6b09ad53ce4ad8d5a429a26", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_6ee4cce4172b405aefb288f98b829040", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_c38a40c75e862a598ad8a42d5d6e0b77", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_e8b984cc954d1a93c0670e47bfd79ffd", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.map_blocks_a", + "equation_Lib.Sequence.seq", + "equation_Lib.Vec.Lemmas.normalize_v_map", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_eq_elim", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1140254f0add9ac82e3c74c399912e35", + "refinement_interpretation_Tm_refine_135aa34345be03950a1f68856adc9696", + "refinement_interpretation_Tm_refine_1f6c16a51cd4ba3256b95ca590c832c5", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_4e46b18e6de7fd724da2ef45eb7b3ba2", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7af7abfd9fa791df66706ab563886df2", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_8710a3dcbb7aeecb1da33ddf8070b919", + "refinement_interpretation_Tm_refine_b913a3f691ca99086652e0a655e72f17", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_dee0f34b44c44e6d512c6db0858b92ef", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.empty", "typing_Lib.Sequence.map_blocks" + ], + 0, + "aef2cbdb6623ff7e91796f4a89ad2b61" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "582cb23c0d2ffafa5bff4fb2657487df" + ] + ] +] \ No newline at end of file diff --git a/tests/hacl/Lib.Vec.Lemmas.fsti.hints b/tests/hacl/Lib.Vec.Lemmas.fsti.hints new file mode 100644 index 00000000000..4d1fb2f46a2 --- /dev/null +++ b/tests/hacl/Lib.Vec.Lemmas.fsti.hints @@ -0,0 +1,403 @@ +[ + "\u0007]à¼Ü–\u001a!WLÞ¬.MŽ", + [ + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6f77474ede8199333d3f4de9c694b4b9", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "445e708733ca11524dfee0e0adbb82b9" + ], + [ + "Lib.Vec.Lemmas.lemma_repeati_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "28a410c23c5f5e2173e048f42167a378" + ], + [ + "Lib.Vec.Lemmas.len_is_w_n_blocksize", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "a69c31cff994a6ad4fe2fd8f8094fe2c" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_Prims.pow2" + ], + 0, + "c4df913dab06b77e3a39c21a29055dc5" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "c087f34c5dd7c857bdcc125d5fdb0268" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_blocks_multi_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "d8e862a82508b4cd497b860cc6a5d2de" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "7931720feee169aab00f30a0a0e82b2f" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1140254f0add9ac82e3c74c399912e35", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d" + ], + 0, + "418b5d570efc45d5dc83ec865dc0f5c5" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_blocks_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.length", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1140254f0add9ac82e3c74c399912e35", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_4e46b18e6de7fd724da2ef45eb7b3ba2", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "6947bff9eec930cb0a375da1c1a8e184" + ], + [ + "Lib.Vec.Lemmas.repeat_blocks_multi_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "a4e97c0a184312b3f4d4a561d9a148d9" + ], + [ + "Lib.Vec.Lemmas.repeat_blocks_multi_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "b234331db7e13c2c90651c03dfd788d4" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_multi_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e90c2c89afe31ba2752cabd31cd7f6e7" + ], + 0, + "228217519cbd846024b8acd1fbf55866" + ], + [ + "Lib.Vec.Lemmas.repeat_blocks_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "a62603edb54c59fe49b91cf8d63a07be" + ], + [ + "Lib.Vec.Lemmas.repeat_blocks_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "6733b74c4434a9f017159df4aa16b9b5" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "176e45cc444f952b0bc46f87d30bc841" + ], + [ + "Lib.Vec.Lemmas.lemma_f_map_ind", + 1, + 0, + 0, + [ "@query" ], + 0, + "94c7bfa95c648d627c1508d1a3c752c9" + ], + [ + "Lib.Vec.Lemmas.map_blocks_multi_vec_equiv_pre_k", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_6ee4cce4172b405aefb288f98b829040", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "70a26ac0d7ccf01051ad26ba5d3c3717" + ], + [ + "Lib.Vec.Lemmas.map_blocks_multi_vec_equiv_pre_k", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "a33605d68fbd6adc580e16849dfddf72" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "typing_Lib.Sequence.length" + ], + 0, + "f301269a55db053a5c12ca45404513e8" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThan", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "bfd3d9e419c0d4ad8127ed518a3ef860" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "066d5d69fc0cf7311373837e3cf406f1" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.length", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_4e46b18e6de7fd724da2ef45eb7b3ba2", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "a50f3aa4d65cb01de63187a70ad28f3c" + ] + ] +] \ No newline at end of file From 629df02f5a6e3fcb051d9c8fec7489f251b49863 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 28 Apr 2024 19:54:11 -0700 Subject: [PATCH 129/239] snap --- .../generated/FStar_TypeChecker_Quals.ml | 155 +++++++++--------- 1 file changed, 79 insertions(+), 76 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Quals.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Quals.ml index af077137589..1e4676af129 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Quals.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Quals.ml @@ -499,85 +499,88 @@ let (check_must_erase_attribute : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.sigelt -> unit) = fun env -> fun se -> - match se.FStar_Syntax_Syntax.sigel with - | FStar_Syntax_Syntax.Sig_let - { FStar_Syntax_Syntax.lbs1 = lbs; FStar_Syntax_Syntax.lids1 = l;_} - -> - let uu___ = - let uu___1 = FStar_Options.ide () in Prims.op_Negation uu___1 in - if uu___ - then - let uu___1 = - let uu___2 = FStar_TypeChecker_Env.dsenv env in - let uu___3 = FStar_TypeChecker_Env.current_module env in - FStar_Syntax_DsEnv.iface_decls uu___2 uu___3 in - (match uu___1 with - | FStar_Pervasives_Native.None -> () - | FStar_Pervasives_Native.Some iface_decls -> - FStar_Compiler_List.iter - (fun lb -> - let lbname = - FStar_Compiler_Util.right - lb.FStar_Syntax_Syntax.lbname in - let has_iface_val = - let uu___2 = - let uu___3 = - FStar_Ident.ident_of_lid - (lbname.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - FStar_Parser_AST.decl_is_val uu___3 in - FStar_Compiler_Util.for_some uu___2 iface_decls in - if has_iface_val - then - let must_erase = - FStar_TypeChecker_Util.must_erase_for_extraction - env lb.FStar_Syntax_Syntax.lbdef in - let has_attr = - FStar_TypeChecker_Env.fv_has_attr env lbname - FStar_Parser_Const.must_erase_for_extraction_attr in - (if must_erase && (Prims.op_Negation has_attr) - then - let uu___2 = - FStar_Syntax_Syntax.range_of_fv lbname in - let uu___3 = - let uu___4 = + let uu___ = FStar_Options.ide () in + if uu___ + then () + else + (match se.FStar_Syntax_Syntax.sigel with + | FStar_Syntax_Syntax.Sig_let + { FStar_Syntax_Syntax.lbs1 = lbs; + FStar_Syntax_Syntax.lids1 = l;_} + -> + let uu___2 = + let uu___3 = FStar_TypeChecker_Env.dsenv env in + let uu___4 = FStar_TypeChecker_Env.current_module env in + FStar_Syntax_DsEnv.iface_decls uu___3 uu___4 in + (match uu___2 with + | FStar_Pervasives_Native.None -> () + | FStar_Pervasives_Native.Some iface_decls -> + FStar_Compiler_List.iter + (fun lb -> + let lbname = + FStar_Compiler_Util.right + lb.FStar_Syntax_Syntax.lbname in + let has_iface_val = + let uu___3 = + let uu___4 = + FStar_Ident.ident_of_lid + (lbname.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + FStar_Parser_AST.decl_is_val uu___4 in + FStar_Compiler_Util.for_some uu___3 iface_decls in + if has_iface_val + then + let must_erase = + FStar_TypeChecker_Util.must_erase_for_extraction + env lb.FStar_Syntax_Syntax.lbdef in + let has_attr = + FStar_TypeChecker_Env.fv_has_attr env lbname + FStar_Parser_Const.must_erase_for_extraction_attr in + (if must_erase && (Prims.op_Negation has_attr) + then + let uu___3 = + FStar_Syntax_Syntax.range_of_fv lbname in + let uu___4 = + let uu___5 = + let uu___6 = + let uu___7 = + let uu___8 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_fv lbname in + let uu___9 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_fv lbname in + FStar_Compiler_Util.format2 + "Values of type `%s` will be erased during extraction, but its interface hides this fact. Add the `must_erase_for_extraction` attribute to the `val %s` declaration for this symbol in the interface" + uu___8 uu___9 in + FStar_Errors_Msg.text uu___7 in + [uu___6] in + (FStar_Errors_Codes.Error_MustEraseMissing, + uu___5) in + FStar_Errors.log_issue_doc uu___3 uu___4 + else + if has_attr && (Prims.op_Negation must_erase) + then + (let uu___4 = + FStar_Syntax_Syntax.range_of_fv lbname in let uu___5 = let uu___6 = let uu___7 = - FStar_Syntax_Print.fv_to_string lbname in - let uu___8 = - FStar_Syntax_Print.fv_to_string lbname in - FStar_Compiler_Util.format2 - "Values of type `%s` will be erased during extraction, but its interface hides this fact. Add the `must_erase_for_extraction` attribute to the `val %s` declaration for this symbol in the interface" - uu___7 uu___8 in - FStar_Errors_Msg.text uu___6 in - [uu___5] in - (FStar_Errors_Codes.Error_MustEraseMissing, - uu___4) in - FStar_Errors.log_issue_doc uu___2 uu___3 - else - if has_attr && (Prims.op_Negation must_erase) - then - (let uu___3 = - FStar_Syntax_Syntax.range_of_fv lbname in - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = - let uu___8 = - FStar_Syntax_Print.fv_to_string - lbname in - FStar_Compiler_Util.format1 - "Values of type `%s` cannot be erased during extraction, but the `must_erase_for_extraction` attribute claims that it can. Please remove the attribute." - uu___8 in - FStar_Errors_Msg.text uu___7 in - [uu___6] in - (FStar_Errors_Codes.Error_MustEraseMissing, - uu___5) in - FStar_Errors.log_issue_doc uu___3 uu___4) - else ()) - else ()) (FStar_Pervasives_Native.snd lbs)) - else () - | uu___ -> () + let uu___8 = + let uu___9 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_fv + lbname in + FStar_Compiler_Util.format1 + "Values of type `%s` cannot be erased during extraction, but the `must_erase_for_extraction` attribute claims that it can. Please remove the attribute." + uu___9 in + FStar_Errors_Msg.text uu___8 in + [uu___7] in + (FStar_Errors_Codes.Error_MustEraseMissing, + uu___6) in + FStar_Errors.log_issue_doc uu___4 uu___5) + else ()) + else ()) (FStar_Pervasives_Native.snd lbs)) + | uu___2 -> ()) let (check_typeclass_instance_attribute : FStar_TypeChecker_Env.env -> FStar_Compiler_Range_Type.range -> FStar_Syntax_Syntax.sigelt -> unit) From 35eb8aaa182d4c72ef5b5a0f31e735409f7891ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 28 Apr 2024 17:52:23 -0700 Subject: [PATCH 130/239] examples: Miniparse: add a .fst.config.json --- examples/miniparse/MiniParse.fst.config.json | 7 +++++++ 1 file changed, 7 insertions(+) create mode 100644 examples/miniparse/MiniParse.fst.config.json diff --git a/examples/miniparse/MiniParse.fst.config.json b/examples/miniparse/MiniParse.fst.config.json new file mode 100644 index 00000000000..6d6e73162ba --- /dev/null +++ b/examples/miniparse/MiniParse.fst.config.json @@ -0,0 +1,7 @@ +{ + "fstar_exe": "fstar.exe", + "options": [ + ], + "include_dirs": [ + ] +} From a1d17b7e22f36167d98c5dfaa24d5b2862202d6a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 28 Apr 2024 17:32:21 -0700 Subject: [PATCH 131/239] RBSet: showable instance --- src/data/FStar.Compiler.RBSet.fst | 4 ++++ src/data/FStar.Compiler.RBSet.fsti | 3 +++ 2 files changed, 7 insertions(+) diff --git a/src/data/FStar.Compiler.RBSet.fst b/src/data/FStar.Compiler.RBSet.fst index 7f74063e05b..a8245ddecf0 100644 --- a/src/data/FStar.Compiler.RBSet.fst +++ b/src/data/FStar.Compiler.RBSet.fst @@ -167,3 +167,7 @@ instance setlike_rbset (a:Type) (_ : ord a) : Tot (setlike a (rbset a)) = { from_list = from_list; addn = addn; } + +instance showable_rbset (a:Type) (_ : showable a) : Tot (showable (rbset a)) = { + show = (fun s -> "RBSet " ^ show (elems s)); +} diff --git a/src/data/FStar.Compiler.RBSet.fsti b/src/data/FStar.Compiler.RBSet.fsti index 0334ba6b958..9f0ba48a0b5 100644 --- a/src/data/FStar.Compiler.RBSet.fsti +++ b/src/data/FStar.Compiler.RBSet.fsti @@ -30,3 +30,6 @@ type t = rbset instance val setlike_rbset (a:Type0) (_ : ord a) : Tot (setlike a (t a)) + +instance +val showable_rbset (a:Type0) (_ : showable a) : Tot (showable (t a)) From 4ad7d3ec346415dac04f84416b3b7bb723998983 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 28 Apr 2024 17:23:03 -0700 Subject: [PATCH 132/239] Syntax.Free: do not use lists anywhere FlatSet instead, which is of course a list, but behind an interface --- src/syntax/FStar.Syntax.Free.fst | 48 ++++++++++++++++------------- src/syntax/FStar.Syntax.Free.fsti | 23 ++++++++------ src/syntax/FStar.Syntax.Syntax.fsti | 8 ++--- 3 files changed, 43 insertions(+), 36 deletions(-) diff --git a/src/syntax/FStar.Syntax.Free.fst b/src/syntax/FStar.Syntax.Free.fst index 226878affaf..b3caaa803c4 100644 --- a/src/syntax/FStar.Syntax.Free.fst +++ b/src/syntax/FStar.Syntax.Free.fst @@ -79,26 +79,30 @@ val (@@) : #a:Type -> {| deq a |} -> list a -> list a -> list a let (@@) xs ys = List.fold_left (fun xs y -> snoc xs y) xs ys let no_free_vars : free_vars_and_fvars = { - free_names=[]; - free_uvars=[]; - free_univs=[]; - free_univ_names=[]; + free_names = empty(); + free_uvars = empty(); + free_univs = empty(); + free_univ_names = empty(); }, empty () let singleton_fvar fv : free_vars_and_fvars = fst no_free_vars, add fv.fv_name.v (empty ()) -let singleton_bv x = {fst no_free_vars with free_names=[x]}, snd no_free_vars -let singleton_uv x = {fst no_free_vars with free_uvars=[x]}, snd no_free_vars -let singleton_univ x = {fst no_free_vars with free_univs=[x]}, snd no_free_vars -let singleton_univ_name x = {fst no_free_vars with free_univ_names=[x]}, snd no_free_vars +let singleton_bv x = + {fst no_free_vars with free_names = singleton x}, snd no_free_vars +let singleton_uv x = + {fst no_free_vars with free_uvars = singleton x}, snd no_free_vars +let singleton_univ x = + {fst no_free_vars with free_univs = singleton x}, snd no_free_vars +let singleton_univ_name x = + {fst no_free_vars with free_univ_names = singleton x}, snd no_free_vars let union (f1 : free_vars_and_fvars) (f2 : free_vars_and_fvars) = { - free_names=(fst f1).free_names @@ (fst f2).free_names; - free_uvars=(fst f1).free_uvars @@ (fst f2).free_uvars; - free_univs=(fst f1).free_univs @@ (fst f2).free_univs; - free_univ_names=(fst f1).free_univ_names @@ (fst f2).free_univ_names; //THE ORDER HERE IS IMPORTANT! + free_names=(fst f1).free_names `union` (fst f2).free_names; + free_uvars=(fst f1).free_uvars `union` (fst f2).free_uvars; + free_univs=(fst f1).free_univs `union` (fst f2).free_univs; + free_univ_names=(fst f1).free_univ_names `union` (fst f2).free_univ_names; //THE ORDER HERE IS IMPORTANT! //We expect the free_univ_names list to be in fifo order to get the right order of universe generalization }, union (snd f1) (snd f2) @@ -285,11 +289,11 @@ and free_names_and_uvars_dec_order dec_order use_cache = and should_invalidate_cache n use_cache = (use_cache <> Def) || - (n.free_uvars |> Util.for_some (fun u -> + (n.free_uvars |> for_any (fun u -> match UF.find u.ctx_uvar_head with | Some _ -> true | _ -> false)) || - (n.free_univs |> Util.for_some (fun u -> + (n.free_univs |> for_any (fun u -> match UF.univ_find u with | Some _ -> true | None -> false)) @@ -297,16 +301,16 @@ and should_invalidate_cache n use_cache = //note use_cache is set false ONLY for fvars, which is not maintained at each AST node //see the comment above -let names t = from_list (fst (free_names_and_uvars t Def)).free_names -let uvars t = from_list (fst (free_names_and_uvars t Def)).free_uvars -let univs t = from_list (fst (free_names_and_uvars t Def)).free_univs +let names t = (fst (free_names_and_uvars t Def)).free_names +let uvars t = (fst (free_names_and_uvars t Def)).free_uvars +let univs t = (fst (free_names_and_uvars t Def)).free_univs -let univnames t = from_list (fst (free_names_and_uvars t Def)).free_univ_names -let univnames_comp c = from_list (fst (free_names_and_uvars_comp c Def)).free_univ_names +let univnames t = (fst (free_names_and_uvars t Def)).free_univ_names +let univnames_comp c = (fst (free_names_and_uvars_comp c Def)).free_univ_names let fvars t = snd (free_names_and_uvars t NoCache) let names_of_binders (bs:binders) = - from_list ((fst (free_names_and_uvars_binders bs Def)).free_names) + ((fst (free_names_and_uvars_binders bs Def)).free_names) -let uvars_uncached t = from_list (fst (free_names_and_uvars t NoCache)).free_uvars -let uvars_full t = from_list (fst (free_names_and_uvars t Full)).free_uvars +let uvars_uncached t = (fst (free_names_and_uvars t NoCache)).free_uvars +let uvars_full t = (fst (free_names_and_uvars t Full)).free_uvars diff --git a/src/syntax/FStar.Syntax.Free.fsti b/src/syntax/FStar.Syntax.Free.fsti index 37a8dcb4802..77bae21698e 100644 --- a/src/syntax/FStar.Syntax.Free.fsti +++ b/src/syntax/FStar.Syntax.Free.fsti @@ -23,16 +23,19 @@ open FStar.Compiler.FlatSet open FStar.Syntax open FStar.Syntax.Syntax -val names: term -> FlatSet.t bv -val uvars: term -> FlatSet.t ctx_uvar -val univs: term -> FlatSet.t universe_uvar -val univnames: term -> FlatSet.t univ_name -val univnames_comp: comp -> FlatSet.t univ_name -val fvars: term -> RBSet.t Ident.lident -val names_of_binders: binders -> FlatSet.t bv - -val uvars_uncached: term -> FlatSet.t ctx_uvar -val uvars_full: term -> FlatSet.t ctx_uvar +val names : term -> FlatSet.t bv +val names_of_binders : binders -> FlatSet.t bv + +val fvars : term -> RBSet.t Ident.lident + +val uvars : term -> FlatSet.t ctx_uvar +val uvars_uncached : term -> FlatSet.t ctx_uvar +val uvars_full : term -> FlatSet.t ctx_uvar + +val univs : term -> FlatSet.t universe_uvar + +val univnames : term -> FlatSet.t univ_name +val univnames_comp : comp -> FlatSet.t univ_name (* Bad place for these instances. But they cannot be instance Syntax.Syntax since they reference the UF graph. *) diff --git a/src/syntax/FStar.Syntax.Syntax.fsti b/src/syntax/FStar.Syntax.Syntax.fsti index 6bc57696c67..1cb9c7793ff 100644 --- a/src/syntax/FStar.Syntax.Syntax.fsti +++ b/src/syntax/FStar.Syntax.Syntax.fsti @@ -379,10 +379,10 @@ and fv = { fv_qual :option fv_qual } and free_vars = { - free_names:list bv; - free_uvars:list ctx_uvar; - free_univs:list universe_uvar; - free_univ_names:list univ_name; //fifo + free_names : FlatSet.t bv; + free_uvars : uvars; + free_univs : FlatSet.t universe_uvar; + free_univ_names : FlatSet.t univ_name; //fifo } (* Residual of a computation type after typechecking *) From 4f75a7ccb0862b1dc1c7b26b84813259bae256c6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 28 Apr 2024 17:59:15 -0700 Subject: [PATCH 133/239] snap --- .../generated/FStar_Compiler_RBSet.ml | 11 + .../fstar-lib/generated/FStar_Syntax_Free.ml | 313 ++++++++++-------- .../generated/FStar_Syntax_Syntax.ml | 17 +- 3 files changed, 190 insertions(+), 151 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Compiler_RBSet.ml b/ocaml/fstar-lib/generated/FStar_Compiler_RBSet.ml index ced3d3439b8..7d93f137aaf 100644 --- a/ocaml/fstar-lib/generated/FStar_Compiler_RBSet.ml +++ b/ocaml/fstar-lib/generated/FStar_Compiler_RBSet.ml @@ -214,4 +214,15 @@ let setlike_rbset : FStar_Class_Setlike.collect = (collect uu___); FStar_Class_Setlike.from_list = (from_list uu___); FStar_Class_Setlike.addn = (addn uu___) + } +let showable_rbset : + 'a . 'a FStar_Class_Show.showable -> 'a t FStar_Class_Show.showable = + fun uu___ -> + { + FStar_Class_Show.show = + (fun s -> + let uu___1 = + let uu___2 = elems s in + FStar_Class_Show.show (FStar_Class_Show.show_list uu___) uu___2 in + Prims.strcat "RBSet " uu___1) } \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml index a8e1153d82c..4902c07cab1 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml @@ -109,17 +109,41 @@ let op_At_At : xs ys let (no_free_vars : free_vars_and_fvars) = let uu___ = + let uu___1 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) ()) in + let uu___2 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_ctx_uvar)) + ()) in + let uu___3 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_univ_uvar)) + ()) in + let uu___4 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) ()) in + { + FStar_Syntax_Syntax.free_names = uu___1; + FStar_Syntax_Syntax.free_uvars = uu___2; + FStar_Syntax_Syntax.free_univs = uu___3; + FStar_Syntax_Syntax.free_univ_names = uu___4 + } in + let uu___1 = Obj.magic (FStar_Class_Setlike.empty () (Obj.magic (FStar_Compiler_RBSet.setlike_rbset FStar_Syntax_Syntax.ord_fv)) ()) in - ({ - FStar_Syntax_Syntax.free_names = []; - FStar_Syntax_Syntax.free_uvars = []; - FStar_Syntax_Syntax.free_univs = []; - FStar_Syntax_Syntax.free_univ_names = [] - }, uu___) + (uu___, uu___1) let (singleton_fvar : FStar_Syntax_Syntax.fv -> free_vars_and_fvars) = fun fv -> let uu___ = @@ -142,64 +166,94 @@ let (singleton_bv : FStar_Compiler_RBSet.t)) = fun x -> - ((let uu___ = FStar_Pervasives_Native.fst no_free_vars in + let uu___ = + let uu___1 = FStar_Pervasives_Native.fst no_free_vars in + let uu___2 = + Obj.magic + (FStar_Class_Setlike.singleton () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) x) in { - FStar_Syntax_Syntax.free_names = [x]; + FStar_Syntax_Syntax.free_names = uu___2; FStar_Syntax_Syntax.free_uvars = - (uu___.FStar_Syntax_Syntax.free_uvars); + (uu___1.FStar_Syntax_Syntax.free_uvars); FStar_Syntax_Syntax.free_univs = - (uu___.FStar_Syntax_Syntax.free_univs); + (uu___1.FStar_Syntax_Syntax.free_univs); FStar_Syntax_Syntax.free_univ_names = - (uu___.FStar_Syntax_Syntax.free_univ_names) - }), (FStar_Pervasives_Native.snd no_free_vars)) + (uu___1.FStar_Syntax_Syntax.free_univ_names) + } in + (uu___, (FStar_Pervasives_Native.snd no_free_vars)) let (singleton_uv : FStar_Syntax_Syntax.ctx_uvar -> (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident FStar_Compiler_RBSet.t)) = fun x -> - ((let uu___ = FStar_Pervasives_Native.fst no_free_vars in + let uu___ = + let uu___1 = FStar_Pervasives_Native.fst no_free_vars in + let uu___2 = + Obj.magic + (FStar_Class_Setlike.singleton () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set ord_ctx_uvar)) x) in { FStar_Syntax_Syntax.free_names = - (uu___.FStar_Syntax_Syntax.free_names); - FStar_Syntax_Syntax.free_uvars = [x]; + (uu___1.FStar_Syntax_Syntax.free_names); + FStar_Syntax_Syntax.free_uvars = uu___2; FStar_Syntax_Syntax.free_univs = - (uu___.FStar_Syntax_Syntax.free_univs); + (uu___1.FStar_Syntax_Syntax.free_univs); FStar_Syntax_Syntax.free_univ_names = - (uu___.FStar_Syntax_Syntax.free_univ_names) - }), (FStar_Pervasives_Native.snd no_free_vars)) + (uu___1.FStar_Syntax_Syntax.free_univ_names) + } in + (uu___, (FStar_Pervasives_Native.snd no_free_vars)) let (singleton_univ : FStar_Syntax_Syntax.universe_uvar -> (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident FStar_Compiler_RBSet.t)) = fun x -> - ((let uu___ = FStar_Pervasives_Native.fst no_free_vars in + let uu___ = + let uu___1 = FStar_Pervasives_Native.fst no_free_vars in + let uu___2 = + Obj.magic + (FStar_Class_Setlike.singleton () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set ord_univ_uvar)) x) in { FStar_Syntax_Syntax.free_names = - (uu___.FStar_Syntax_Syntax.free_names); + (uu___1.FStar_Syntax_Syntax.free_names); FStar_Syntax_Syntax.free_uvars = - (uu___.FStar_Syntax_Syntax.free_uvars); - FStar_Syntax_Syntax.free_univs = [x]; + (uu___1.FStar_Syntax_Syntax.free_uvars); + FStar_Syntax_Syntax.free_univs = uu___2; FStar_Syntax_Syntax.free_univ_names = - (uu___.FStar_Syntax_Syntax.free_univ_names) - }), (FStar_Pervasives_Native.snd no_free_vars)) + (uu___1.FStar_Syntax_Syntax.free_univ_names) + } in + (uu___, (FStar_Pervasives_Native.snd no_free_vars)) let (singleton_univ_name : FStar_Syntax_Syntax.univ_name -> (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident FStar_Compiler_RBSet.t)) = fun x -> - ((let uu___ = FStar_Pervasives_Native.fst no_free_vars in + let uu___ = + let uu___1 = FStar_Pervasives_Native.fst no_free_vars in + let uu___2 = + Obj.magic + (FStar_Class_Setlike.singleton () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) x) in { FStar_Syntax_Syntax.free_names = - (uu___.FStar_Syntax_Syntax.free_names); + (uu___1.FStar_Syntax_Syntax.free_names); FStar_Syntax_Syntax.free_uvars = - (uu___.FStar_Syntax_Syntax.free_uvars); + (uu___1.FStar_Syntax_Syntax.free_uvars); FStar_Syntax_Syntax.free_univs = - (uu___.FStar_Syntax_Syntax.free_univs); - FStar_Syntax_Syntax.free_univ_names = [x] - }), (FStar_Pervasives_Native.snd no_free_vars)) + (uu___1.FStar_Syntax_Syntax.free_univs); + FStar_Syntax_Syntax.free_univ_names = uu___2 + } in + (uu___, (FStar_Pervasives_Native.snd no_free_vars)) let (union : free_vars_and_fvars -> free_vars_and_fvars -> @@ -210,21 +264,43 @@ let (union : fun f2 -> let uu___ = let uu___1 = - op_At_At FStar_Syntax_Syntax.deq_bv - (FStar_Pervasives_Native.fst f1).FStar_Syntax_Syntax.free_names - (FStar_Pervasives_Native.fst f2).FStar_Syntax_Syntax.free_names in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic + (FStar_Pervasives_Native.fst f1).FStar_Syntax_Syntax.free_names) + (Obj.magic + (FStar_Pervasives_Native.fst f2).FStar_Syntax_Syntax.free_names)) in let uu___2 = - op_At_At deq_ctx_uvar - (FStar_Pervasives_Native.fst f1).FStar_Syntax_Syntax.free_uvars - (FStar_Pervasives_Native.fst f2).FStar_Syntax_Syntax.free_uvars in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set ord_ctx_uvar)) + (Obj.magic + (FStar_Pervasives_Native.fst f1).FStar_Syntax_Syntax.free_uvars) + (Obj.magic + (FStar_Pervasives_Native.fst f2).FStar_Syntax_Syntax.free_uvars)) in let uu___3 = - op_At_At deq_univ_uvar - (FStar_Pervasives_Native.fst f1).FStar_Syntax_Syntax.free_univs - (FStar_Pervasives_Native.fst f2).FStar_Syntax_Syntax.free_univs in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set ord_univ_uvar)) + (Obj.magic + (FStar_Pervasives_Native.fst f1).FStar_Syntax_Syntax.free_univs) + (Obj.magic + (FStar_Pervasives_Native.fst f2).FStar_Syntax_Syntax.free_univs)) in let uu___4 = - op_At_At FStar_Syntax_Syntax.deq_univ_name - (FStar_Pervasives_Native.fst f1).FStar_Syntax_Syntax.free_univ_names - (FStar_Pervasives_Native.fst f2).FStar_Syntax_Syntax.free_univ_names in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) + (Obj.magic + (FStar_Pervasives_Native.fst f1).FStar_Syntax_Syntax.free_univ_names) + (Obj.magic + (FStar_Pervasives_Native.fst f2).FStar_Syntax_Syntax.free_univ_names)) in { FStar_Syntax_Syntax.free_names = uu___1; FStar_Syntax_Syntax.free_uvars = uu___2; @@ -267,13 +343,14 @@ let rec (free_names_and_uvs' : FStar_Compiler_Effect.failwith "Impossible" | FStar_Syntax_Syntax.Tm_name x -> singleton_bv x | FStar_Syntax_Syntax.Tm_uvar (uv, (s, uu___)) -> - let uu___1 = + let uu___1 = singleton_uv uv in + let uu___2 = if use_cache = Full then - let uu___2 = ctx_uvar_typ uv in - free_names_and_uvars uu___2 use_cache + let uu___3 = ctx_uvar_typ uv in + free_names_and_uvars uu___3 use_cache else no_free_vars in - union (singleton_uv uv) uu___1 + union uu___1 uu___2 | FStar_Syntax_Syntax.Tm_type u -> free_univs u | FStar_Syntax_Syntax.Tm_bvar uu___ -> no_free_vars | FStar_Syntax_Syntax.Tm_fvar fv -> singleton_fvar fv @@ -563,100 +640,69 @@ and (should_invalidate_cache : fun n -> fun use_cache -> ((use_cache <> Def) || - (FStar_Compiler_Util.for_some + (FStar_Class_Setlike.for_any () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_ctx_uvar)) (fun u -> let uu___ = FStar_Syntax_Unionfind.find u.FStar_Syntax_Syntax.ctx_uvar_head in match uu___ with | FStar_Pervasives_Native.Some uu___1 -> true - | uu___1 -> false) n.FStar_Syntax_Syntax.free_uvars)) + | uu___1 -> false) + (Obj.magic n.FStar_Syntax_Syntax.free_uvars))) || - (FStar_Compiler_Util.for_some + (FStar_Class_Setlike.for_any () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_univ_uvar)) (fun u -> let uu___ = FStar_Syntax_Unionfind.univ_find u in match uu___ with | FStar_Pervasives_Native.Some uu___1 -> true | FStar_Pervasives_Native.None -> false) - n.FStar_Syntax_Syntax.free_univs) + (Obj.magic n.FStar_Syntax_Syntax.free_univs)) let (names : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t) = - fun uu___ -> - (fun t -> - let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars t Def in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_names in - Obj.magic - (FStar_Class_Setlike.from_list () - (Obj.magic - (FStar_Compiler_FlatSet.setlike_flat_set - FStar_Syntax_Syntax.ord_bv)) uu___)) uu___ + fun t -> + let uu___ = + let uu___1 = free_names_and_uvars t Def in + FStar_Pervasives_Native.fst uu___1 in + uu___.FStar_Syntax_Syntax.free_names let (uvars : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_FlatSet.t) = - fun uu___ -> - (fun t -> - let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars t Def in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_uvars in - Obj.magic - (FStar_Class_Setlike.from_list () - (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_ctx_uvar)) - uu___)) uu___ + fun t -> + let uu___ = + let uu___1 = free_names_and_uvars t Def in + FStar_Pervasives_Native.fst uu___1 in + uu___.FStar_Syntax_Syntax.free_uvars let (univs : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.universe_uvar FStar_Compiler_FlatSet.t) = - fun uu___ -> - (fun t -> - let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars t Def in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_univs in - Obj.magic - (FStar_Class_Setlike.from_list () - (Obj.magic - (FStar_Compiler_FlatSet.setlike_flat_set ord_univ_uvar)) uu___)) - uu___ + fun t -> + let uu___ = + let uu___1 = free_names_and_uvars t Def in + FStar_Pervasives_Native.fst uu___1 in + uu___.FStar_Syntax_Syntax.free_univs let (univnames : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.univ_name FStar_Compiler_FlatSet.t) = - fun uu___ -> - (fun t -> - let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars t Def in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_univ_names in - Obj.magic - (FStar_Class_Setlike.from_list () - (Obj.magic - (FStar_Compiler_FlatSet.setlike_flat_set - FStar_Syntax_Syntax.ord_ident)) uu___)) uu___ + fun t -> + let uu___ = + let uu___1 = free_names_and_uvars t Def in + FStar_Pervasives_Native.fst uu___1 in + uu___.FStar_Syntax_Syntax.free_univ_names let (univnames_comp : FStar_Syntax_Syntax.comp -> FStar_Syntax_Syntax.univ_name FStar_Compiler_FlatSet.t) = - fun uu___ -> - (fun c -> - let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars_comp c Def in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_univ_names in - Obj.magic - (FStar_Class_Setlike.from_list () - (Obj.magic - (FStar_Compiler_FlatSet.setlike_flat_set - FStar_Syntax_Syntax.ord_ident)) uu___)) uu___ + fun c -> + let uu___ = + let uu___1 = free_names_and_uvars_comp c Def in + FStar_Pervasives_Native.fst uu___1 in + uu___.FStar_Syntax_Syntax.free_univ_names let (fvars : FStar_Syntax_Syntax.term -> FStar_Ident.lident FStar_Compiler_RBSet.t) = fun t -> @@ -666,45 +712,26 @@ let (names_of_binders : FStar_Syntax_Syntax.binders -> FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t) = - fun uu___ -> - (fun bs -> - let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars_binders bs Def in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_names in - Obj.magic - (FStar_Class_Setlike.from_list () - (Obj.magic - (FStar_Compiler_FlatSet.setlike_flat_set - FStar_Syntax_Syntax.ord_bv)) uu___)) uu___ + fun bs -> + let uu___ = + let uu___1 = free_names_and_uvars_binders bs Def in + FStar_Pervasives_Native.fst uu___1 in + uu___.FStar_Syntax_Syntax.free_names let (uvars_uncached : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_FlatSet.t) = - fun uu___ -> - (fun t -> - let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars t NoCache in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_uvars in - Obj.magic - (FStar_Class_Setlike.from_list () - (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_ctx_uvar)) - uu___)) uu___ + fun t -> + let uu___ = + let uu___1 = free_names_and_uvars t NoCache in + FStar_Pervasives_Native.fst uu___1 in + uu___.FStar_Syntax_Syntax.free_uvars let (uvars_full : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_FlatSet.t) = - fun uu___ -> - (fun t -> - let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars t Full in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_uvars in - Obj.magic - (FStar_Class_Setlike.from_list () - (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_ctx_uvar)) - uu___)) uu___ \ No newline at end of file + fun t -> + let uu___ = + let uu___1 = free_names_and_uvars t Full in + FStar_Pervasives_Native.fst uu___1 in + uu___.FStar_Syntax_Syntax.free_uvars \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml index f7b8282b893..b103a7cec3e 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml @@ -381,10 +381,10 @@ and fv = { fv_qual: fv_qual FStar_Pervasives_Native.option } and free_vars = { - free_names: bv Prims.list ; - free_uvars: ctx_uvar Prims.list ; - free_univs: universe_uvar Prims.list ; - free_univ_names: univ_name Prims.list } + free_names: bv FStar_Compiler_FlatSet.t ; + free_uvars: ctx_uvar FStar_Compiler_FlatSet.t ; + free_univs: universe_uvar FStar_Compiler_FlatSet.t ; + free_univ_names: univ_name FStar_Compiler_FlatSet.t } and residual_comp = { residual_effect: FStar_Ident.lident ; @@ -973,22 +973,23 @@ let (__proj__Mkfv__item__fv_qual : fv -> fv_qual FStar_Pervasives_Native.option) = fun projectee -> match projectee with | { fv_name; fv_qual = fv_qual1;_} -> fv_qual1 -let (__proj__Mkfree_vars__item__free_names : free_vars -> bv Prims.list) = +let (__proj__Mkfree_vars__item__free_names : + free_vars -> bv FStar_Compiler_FlatSet.t) = fun projectee -> match projectee with | { free_names; free_uvars; free_univs; free_univ_names;_} -> free_names let (__proj__Mkfree_vars__item__free_uvars : - free_vars -> ctx_uvar Prims.list) = + free_vars -> ctx_uvar FStar_Compiler_FlatSet.t) = fun projectee -> match projectee with | { free_names; free_uvars; free_univs; free_univ_names;_} -> free_uvars let (__proj__Mkfree_vars__item__free_univs : - free_vars -> universe_uvar Prims.list) = + free_vars -> universe_uvar FStar_Compiler_FlatSet.t) = fun projectee -> match projectee with | { free_names; free_uvars; free_univs; free_univ_names;_} -> free_univs let (__proj__Mkfree_vars__item__free_univ_names : - free_vars -> univ_name Prims.list) = + free_vars -> univ_name FStar_Compiler_FlatSet.t) = fun projectee -> match projectee with | { free_names; free_uvars; free_univs; free_univ_names;_} -> From 2be00c7c1c83a4a29cad90eaa48a9ba3f3deb3c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 28 Apr 2024 20:48:11 -0700 Subject: [PATCH 134/239] Syntax/SMT: Structure SMT errors (and Meta_labeled) --- .../FStar.SMTEncoding.EncodeTerm.fst | 6 ++-- .../FStar.SMTEncoding.ErrorReporting.fst | 30 ++++++++++--------- src/smtencoding/FStar.SMTEncoding.Solver.fst | 17 ++++++----- src/smtencoding/FStar.SMTEncoding.Term.fst | 4 +-- src/smtencoding/FStar.SMTEncoding.Term.fsti | 6 ++-- src/syntax/FStar.Syntax.Hash.fst | 9 ++++-- src/syntax/FStar.Syntax.Print.fst | 4 +-- src/syntax/FStar.Syntax.Resugar.fst | 2 +- src/syntax/FStar.Syntax.Syntax.fsti | 2 +- src/tactics/FStar.Tactics.Hooks.fst | 16 ++++++---- src/tosyntax/FStar.ToSyntax.ToSyntax.fst | 3 +- src/typechecker/FStar.TypeChecker.Err.fst | 27 +++++++++-------- .../FStar.TypeChecker.TcInductive.fst | 8 ++++- src/typechecker/FStar.TypeChecker.TcTerm.fst | 10 +++---- src/typechecker/FStar.TypeChecker.Util.fst | 4 +-- src/typechecker/FStar.TypeChecker.Util.fsti | 6 ++-- 16 files changed, 89 insertions(+), 65 deletions(-) diff --git a/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst b/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst index 44ed6c6c937..9c7a1ed5435 100644 --- a/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst +++ b/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst @@ -1593,15 +1593,17 @@ and encode_formula (phi:typ) (env:env_t) : (term * decls_t) = (* expects phi to encode_formula phi env | Tm_fvar fv, [(r, _); (msg, _); (phi, _)] when S.fv_eq_lid fv Const.labeled_lid -> //interpret (labeled r msg t) as Tm_meta(t, Meta_labeled(msg, r, false) + (* NB: below we use Errors.mkmsg since FStar.Range.labeled takes a string, but + the Meta_labeled node needs a list of docs (Errors.error_message). *) begin match SE.try_unembed r SE.id_norm_cb, SE.try_unembed msg SE.id_norm_cb with | Some r, Some s -> - let phi = S.mk (Tm_meta {tm=phi; meta=Meta_labeled(s, r, false)}) r in + let phi = S.mk (Tm_meta {tm=phi; meta=Meta_labeled(Errors.mkmsg s, r, false)}) r in fallback phi (* If we could not unembed the position, still use the string *) | None, Some s -> - let phi = S.mk (Tm_meta {tm=phi; meta=Meta_labeled(s, phi.pos, false)}) phi.pos in + let phi = S.mk (Tm_meta {tm=phi; meta=Meta_labeled(Errors.mkmsg s, phi.pos, false)}) phi.pos in fallback phi | _ -> diff --git a/src/smtencoding/FStar.SMTEncoding.ErrorReporting.fst b/src/smtencoding/FStar.SMTEncoding.ErrorReporting.fst index 597c6ce2bdd..5ff32433445 100644 --- a/src/smtencoding/FStar.SMTEncoding.ErrorReporting.fst +++ b/src/smtencoding/FStar.SMTEncoding.ErrorReporting.fst @@ -37,7 +37,7 @@ type ranges = list (option string * Range.range) //decorate a term with an error label let __ctr = BU.mk_ref 0 -let fresh_label : string -> Range.range -> term -> label * term = +let fresh_label : Errors.error_message -> Range.range -> term -> label * term = fun message range t -> let l = incr __ctr; format1 "label_%s" (string_of_int !__ctr) in let lvar = mk_fv (l, Bool_sort) in @@ -86,11 +86,12 @@ let label_goals use_env_msg //when present, provides an alternate error message in let is_a_named_continuation lhs = conjuncts lhs |> BU.for_some is_guard_free in let flag, msg_prefix = match use_env_msg with - | None -> false, "" - | Some f -> true, f() in + | None -> false, Pprint.empty + | Some f -> true, Pprint.doc_of_string (f()) in let fresh_label msg ropt rng t = + let open FStar.Pprint in let msg = if flag - then "Failed to verify implicit argument: " ^ msg_prefix ^ " :: " ^ msg + then (Errors.Msg.text "Failed to verify implicit argument: " ^^ msg_prefix) :: msg else msg in let rng = match ropt with | None -> rng @@ -100,7 +101,7 @@ let label_goals use_env_msg //when present, provides an alternate error message in fresh_label msg rng t in - let rec aux (default_msg:string) //the error message text to generate at a label + let rec aux (default_msg : Errors.error_message) //the error message text to generate at a label (ropt:option Range.range) //an optional position, if there was an enclosing Labeled node (post_name_opt:option string) //the name of the current post-condition variable --- it is left uninstrumented (labels:list label) //the labels accumulated so far @@ -114,7 +115,7 @@ let label_goals use_env_msg //when present, provides an alternate error message | LblPos _ -> failwith "Impossible" //these get added after errorReporting instrumentation only - | Labeled(arg, "Could not prove post-condition", label_range) -> + | Labeled(arg, [d], label_range) when Errors.Msg.renderdoc d = "Could not prove post-condition" -> //printfn "GOT A LABELED WP IMPLICATION\n\t%s" // (Term.print_smt_term q); let fallback debug_msg = @@ -138,7 +139,7 @@ let label_goals use_env_msg //when present, provides an alternate error message | Quant(Forall, pats_ens, iopt_ens, sorts_ens, {tm=App(Imp, [ensures_conjuncts; post]); rng=rng_ens}) -> if is_a_post_condition (Some post_name) post then - let labels, ensures_conjuncts = aux "Could not prove post-condition" None (Some post_name) labels ensures_conjuncts in + let labels, ensures_conjuncts = aux (Errors.mkmsg "Could not prove post-condition") None (Some post_name) labels ensures_conjuncts in let pats_ens = match pats_ens with | [] @@ -295,7 +296,7 @@ let label_goals use_env_msg //when present, provides an alternate error message labels, Term.mkLet (es, body) q.rng in __ctr := 0; - aux "Assertion failed" None None [] q + aux (Errors.mkmsg "Assertion failed") None None [] q (* @@ -325,15 +326,16 @@ let detail_errors hint_replay in let print_result ((_, msg, r), success) = + let open FStar.Pprint in + let open FStar.Errors.Msg in if success then BU.print1 "OK: proof obligation at %s was proven in isolation\n" (Range.string_of_range r) else if hint_replay - then FStar.Errors.log_issue r (Errors.Warning_HintFailedToReplayProof, - "Hint failed to replay this sub-proof: " ^ msg) - else FStar.Errors.log_issue r (Errors.Error_ProofObligationFailed, - BU.format2 "XX: proof obligation at %s failed\n\t%s\n" - (Range.string_of_range r) - msg) + then FStar.Errors.log_issue_doc r (Errors.Warning_HintFailedToReplayProof, + (text "Hint failed to replay this sub-proof" :: msg)) + else FStar.Errors.log_issue_doc r (Errors.Error_ProofObligationFailed, [ + text <| BU.format1 "XX: proof obligation at %s failed." (Class.Show.show r); + ] @ msg) in let elim labs = //assumes that all the labs are true, effectively removing them from the query diff --git a/src/smtencoding/FStar.SMTEncoding.Solver.fst b/src/smtencoding/FStar.SMTEncoding.Solver.fst index 569a6561fca..4b675a01082 100644 --- a/src/smtencoding/FStar.SMTEncoding.Solver.fst +++ b/src/smtencoding/FStar.SMTEncoding.Solver.fst @@ -321,7 +321,7 @@ let query_errors settings z3result = error_messages = error_labels |> List.map (fun (_, x, y) -> Errors.Error_Z3SolverError, - Errors.mkmsg x, + x, y, Errors.get_ctx ()) // FIXME: leaking abstraction } @@ -442,7 +442,7 @@ let errors_to_report (tried_recovery : bool) (settings : query_settings) : list //we have a unique label already; just report it FStar.TypeChecker.Err.errors_smt_detail settings.query_env - [(Error_Z3SolverError, mkmsg msg, rng, get_ctx())] + [(Error_Z3SolverError, msg, rng, get_ctx())] recovery_failed_msg | None, _ -> @@ -461,9 +461,10 @@ let errors_to_report (tried_recovery : bool) (settings : query_settings) : list //with no labeled sub-goals and so no error location to report. //So, print the source location and the query term itself let dummy_fv = Term.mk_fv ("", dummy_sort) in - let msg = - BU.format1 "Failed to prove the following goal, although it appears to be trivial: %s" - (Print.term_to_string settings.query_term) + let msg = [ + Errors.Msg.text "Failed to prove the following goal, although it appears to be trivial:" + ^/^ pp settings.query_term; + ] in let range = Env.get_range settings.query_env in [dummy_fv, msg, range] @@ -490,7 +491,7 @@ let errors_to_report (tried_recovery : bool) (settings : query_settings) : list List.collect (fun (_, msg, rng) -> FStar.TypeChecker.Err.errors_smt_detail settings.query_env - [(Error_Z3SolverError, mkmsg msg, rng, get_ctx())] + [(Error_Z3SolverError, msg, rng, get_ctx())] recovery_failed_msg ) ) @@ -670,8 +671,8 @@ let query_info settings z3result = ]; if Options.print_z3_statistics () then process_unsat_core core; errs |> List.iter (fun (_, msg, range) -> - let tag = if used_hint settings then "(Hint-replay failed): " else "" in - FStar.Errors.log_issue range (FStar.Errors.Warning_HitReplayFailed, (tag ^ msg))) + let msg = if used_hint settings then Pprint.doc_of_string "Hint-replay failed" :: msg else msg in + FStar.Errors.log_issue_doc range (FStar.Errors.Warning_HitReplayFailed, msg)) end //caller must ensure that the recorded_hints is already initiailized diff --git a/src/smtencoding/FStar.SMTEncoding.Term.fst b/src/smtencoding/FStar.SMTEncoding.Term.fst index 5858d4981d7..26e9b57e2a1 100644 --- a/src/smtencoding/FStar.SMTEncoding.Term.fst +++ b/src/smtencoding/FStar.SMTEncoding.Term.fst @@ -233,7 +233,7 @@ let rec hash_of_term' t = match t with | BoundV i -> "@"^string_of_int i | FreeV x -> fv_name x ^ ":" ^ strSort (fv_sort x) //Question: Why is the sort part of the hash? | App(op, tms) -> "("^(op_to_string op)^(List.map hash_of_term tms |> String.concat " ")^")" - | Labeled(t, r1, r2) -> hash_of_term t ^ r1 ^ (Range.string_of_range r2) + | Labeled(t, r1, r2) -> hash_of_term t ^ Errors.Msg.rendermsg r1 ^ (Range.string_of_range r2) | LblPos(t, r) -> "(! " ^hash_of_term t^ " :lblpos " ^r^ ")" | Quant(qop, pats, wopt, sorts, body) -> "(" @@ -431,7 +431,7 @@ let check_pattern_ok (t:term) : option term = | BoundV n -> BU.format1 "(BoundV %s)" (BU.string_of_int n) | FreeV fv -> BU.format1 "(FreeV %s)" (fv_name fv) | App (op, l) -> BU.format2 "(%s %s)" (op_to_string op) (print_smt_term_list l) - | Labeled(t, r1, r2) -> BU.format2 "(Labeled '%s' %s)" r1 (print_smt_term t) + | Labeled(t, r1, r2) -> BU.format2 "(Labeled '%s' %s)" (Errors.Msg.rendermsg r1) (print_smt_term t) | LblPos(t, s) -> BU.format2 "(LblPos %s %s)" s (print_smt_term t) | Quant (qop, l, _, _, t) -> BU.format3 "(%s %s %s)" (qop_to_string qop) (print_smt_term_list_list l) (print_smt_term t) | Let (es, body) -> BU.format2 "(let %s %s)" (print_smt_term_list es) (print_smt_term body) diff --git a/src/smtencoding/FStar.SMTEncoding.Term.fsti b/src/smtencoding/FStar.SMTEncoding.Term.fsti index 462b1c41477..249bdca5e30 100644 --- a/src/smtencoding/FStar.SMTEncoding.Term.fsti +++ b/src/smtencoding/FStar.SMTEncoding.Term.fsti @@ -84,8 +84,8 @@ type term' = | App of op * list term | Quant of qop * list (list pat) * option int * list sort * term | Let of list term * term - | Labeled of term * string * Range.range - | LblPos of term * string + | Labeled of term * Errors.error_message * Range.range + | LblPos of term * string // FIXME: this case is unused and pat = term and term = {tm:term'; freevars:S.memo fvs; rng:Range.range} and fv = | FV of string * sort * bool (* bool iff variable must be forced/unthunked *) @@ -190,7 +190,7 @@ val mk_decls_trivial: list decl -> decls_t *) val decls_list_of: decls_t -> list decl -type error_label = (fv * string * Range.range) +type error_label = (fv * Errors.error_message * Range.range) type error_labels = list error_label val escape: string -> string diff --git a/src/syntax/FStar.Syntax.Hash.fst b/src/syntax/FStar.Syntax.Hash.fst index fb48dfdd8e9..c263d81793f 100644 --- a/src/syntax/FStar.Syntax.Hash.fst +++ b/src/syntax/FStar.Syntax.Hash.fst @@ -73,12 +73,17 @@ let mix_list_lit = mix_list let hash_list (h:'a -> mm H.hash_code) (ts:list 'a) : mm H.hash_code = mix_list (List.map h ts) - let hash_option (h:'a -> mm H.hash_code) (o:option 'a) : mm H.hash_code = match o with | None -> ret (H.of_int 1237) | Some o -> mix (ret (H.of_int 1249)) (h o) +// hash the string. +let hash_doc (d : Pprint.document) : mm H.hash_code = + of_string (Pprint.pretty_string (float_of_string "1.0") 80 d) + +let hash_doc_list (ds : list Pprint.document) : mm H.hash_code = + hash_list hash_doc ds let hash_pair (h:'a -> mm H.hash_code) (i:'b -> mm H.hash_code) (x:('a * 'b)) : mm H.hash_code @@ -298,7 +303,7 @@ and hash_meta m = | Meta_labeled (s, r, _) -> mix_list_lit [ of_int 1031; - of_string s; + hash_doc_list s; of_string (Range.string_of_range r) ] | Meta_desugared msi -> mix_list_lit diff --git a/src/syntax/FStar.Syntax.Print.fst b/src/syntax/FStar.Syntax.Print.fst index 651bfc27bcb..bae29bae17f 100644 --- a/src/syntax/FStar.Syntax.Print.fst +++ b/src/syntax/FStar.Syntax.Print.fst @@ -249,7 +249,7 @@ and term_to_string x = | Tm_meta {tm=t; meta=Meta_monadic_lift(m0, m1, t')} -> U.format4 ("(MetaMonadicLift-{%s : %s -> %s} %s)") (term_to_string t') (sli m0) (sli m1) (term_to_string t) | Tm_meta {tm=t; meta=Meta_labeled(l,r,b)} -> - U.format3 "Meta_labeled(%s, %s){%s}" l (Range.string_of_range r) (term_to_string t) + U.format3 "Meta_labeled(%s, %s){%s}" (Errors.Msg.rendermsg l) (Range.string_of_range r) (term_to_string t) | Tm_meta {tm=t; meta=Meta_named(l)} -> U.format3 "Meta_named(%s, %s){%s}" (lid_to_string l) (Range.string_of_range t.pos) (term_to_string t) @@ -559,7 +559,7 @@ and metadata_to_string = function U.format1 "{Meta_named %s}" (sli lid) | Meta_labeled (l, r, _) -> - U.format2 "{Meta_labeled (%s, %s)}" l (Range.string_of_range r) + U.format2 "{Meta_labeled (%s, %s)}" (Errors.Msg.rendermsg l) (Range.string_of_range r) | Meta_desugared msi -> "{Meta_desugared}" diff --git a/src/syntax/FStar.Syntax.Resugar.fst b/src/syntax/FStar.Syntax.Resugar.fst index 9b2c2418380..72112cda06c 100644 --- a/src/syntax/FStar.Syntax.Resugar.fst +++ b/src/syntax/FStar.Syntax.Resugar.fst @@ -593,7 +593,7 @@ let rec resugar_term' (env: DsEnv.env) (t : S.term) : A.term = body | Meta_labeled (s, r, p) -> // this case can occur in typechecker when a failure is wrapped in meta_labeled - [], mk (A.Labeled (body, s, p)) + [], mk (A.Labeled (body, Errors.Msg.rendermsg s, p)) | _ -> failwith "wrong pattern format for QForall/QExists" in pats, body diff --git a/src/syntax/FStar.Syntax.Syntax.fsti b/src/syntax/FStar.Syntax.Syntax.fsti index 1cb9c7793ff..8934c154c38 100644 --- a/src/syntax/FStar.Syntax.Syntax.fsti +++ b/src/syntax/FStar.Syntax.Syntax.fsti @@ -327,7 +327,7 @@ and cflag = (* flags applic and metadata = | Meta_pattern of list term * list args (* Patterns for SMT quantifier instantiation; the first arg instantiation *) | Meta_named of lident (* Useful for pretty printing to keep the type abbreviation around *) - | Meta_labeled of string * Range.range * bool (* Sub-terms in a VC are labeled with error messages to be reported, used in SMT encoding *) + | Meta_labeled of list Pprint.document * Range.range * bool (* Sub-terms in a VC are labeled with error messages to be reported, used in SMT encoding *) | Meta_desugared of meta_source_info (* Node tagged with some information about source term before desugaring *) | Meta_monadic of monad_name * typ (* Annotation on a Tm_app or Tm_let node in case it is monadic for m not in {Pure, Ghost, Div} *) (* Contains the name of the monadic effect and the type of the subterm *) diff --git a/src/tactics/FStar.Tactics.Hooks.fst b/src/tactics/FStar.Tactics.Hooks.fst index d2bc17d5f5b..41eca848e2e 100644 --- a/src/tactics/FStar.Tactics.Hooks.fst +++ b/src/tactics/FStar.Tactics.Hooks.fst @@ -328,8 +328,12 @@ let preprocess (env:Env.env) (goal:term) if !tacdbg then BU.print2 "Got goal #%s: %s\n" (show n) (show (goal_type g)); let label = - "Could not prove goal #" ^ show n ^ - (if get_label g = "" then "" else " (" ^ get_label g ^ ")") + let open FStar.Pprint in + let open FStar.Class.PP in + [ + doc_of_string "Could not prove goal #" ^^ pp n ^/^ + (if get_label g = "" then empty else parens (doc_of_string <| get_label g)) + ] in let gt' = TcUtil.label label (goal_range g) phi in (n+1, (goal_env g, gt', goal_opts g)::gs)) s gs in @@ -341,18 +345,18 @@ let preprocess (env:Env.env) (goal:term) let rec traverse_for_spinoff (pol:pol) - (label_ctx:option (string & Range.range)) + (label_ctx:option (list Pprint.document & Range.range)) (e:Env.env) (t:term) : tres = let debug_any = Options.debug_any () in let debug = Env.debug e (O.Other "SpinoffAll") in let traverse pol e t = traverse_for_spinoff pol label_ctx e t in - let traverse_ctx pol ctx e t = + let traverse_ctx pol (ctx : list Pprint.document & Range.range) (e:Env.env) (t:term) : tres = let print_lc (msg, rng) = BU.format3 "(%s,%s) : %s" (Range.string_of_def_range rng) (Range.string_of_use_range rng) - msg + (Errors.Msg.rendermsg msg) in if debug then BU.print2 "Changing label context from %s to %s" @@ -385,7 +389,7 @@ let rec traverse_for_spinoff res in let maybe_spinoff pol - (label_ctx:option (string & Range.range)) + (label_ctx:option (list Pprint.document & Range.range)) (e:Env.env) (t:term) : tres = diff --git a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst index f6d0fa59c4c..3a76d251558 100644 --- a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst +++ b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst @@ -2630,7 +2630,8 @@ and desugar_formula env (f:term) : S.term = match (unparen f).tm with | Labeled(f, l, p) -> let f = desugar_formula env f in - mk <| Tm_meta {tm=f; meta=Meta_labeled(l, f.pos, p)} + // GM: I don't think this case really happens? + mk <| Tm_meta {tm=f; meta=Meta_labeled(Errors.Msg.mkmsg l, f.pos, p)} | QForall([], _, _) | QExists([], _, _) diff --git a/src/typechecker/FStar.TypeChecker.Err.fst b/src/typechecker/FStar.TypeChecker.Err.fst index 0a7110365ba..d0717b5ed19 100644 --- a/src/typechecker/FStar.TypeChecker.Err.fst +++ b/src/typechecker/FStar.TypeChecker.Err.fst @@ -33,6 +33,9 @@ module BU = FStar.Compiler.Util //basic util module Env = FStar.TypeChecker.Env open FStar.TypeChecker.Common +open FStar.Errors.Msg +open FStar.Class.PP + let info_at_pos env file row col = match TypeChecker.Common.id_info_at_pos !env.identifier_info file row col with | None -> None @@ -123,12 +126,6 @@ let print_discrepancy (#a:Type) (#b:eqtype) (f : a -> b) (x : a) (y : a) : b * b in Options.with_saved_options (fun () -> go bas) -(* - * AR: smt_detail is either an Inr of a long multi-line message or Inr of a short one - * in the first case, we print it starting from a newline, - * while in the latter, it is printed on the same line - * GM: TODO: Use a document? - *) let errors_smt_detail env (errs : list Errors.error) (smt_detail : Errors.error_message) @@ -179,14 +176,20 @@ let err_msg_comp_strings env c1 c2 :(string * string) = print_discrepancy (N.comp_to_string env) c1 c2 (* Error messages for labels in VCs *) -let exhaustiveness_check = "Patterns are incomplete" +let exhaustiveness_check = [ + FStar.Errors.Msg.text "Patterns are incomplete" +] -let subtyping_failed : env -> typ -> typ -> unit -> string = +let subtyping_failed : env -> typ -> typ -> unit -> error_message = fun env t1 t2 () -> - let s1, s2 = err_msg_type_strings env t1 t2 in - BU.format2 "Subtyping check failed; expected type %s; got type %s" s2 s1 -let ill_kinded_type = "Ill-kinded type" -let totality_check = "This term may not terminate" + // let s1, s2 = err_msg_type_strings env t1 t2 in + let ppt = N.term_to_doc env in + [text "Subtyping check failed"; + prefix 2 1 (text "Expected type") (ppt t2) ^/^ + prefix 2 1 (text "got type") (ppt t1); + ] + +let ill_kinded_type = Errors.mkmsg "Ill-kinded type" let unexpected_signature_for_monad env m k = (Errors.Fatal_UnexpectedSignatureForMonad, (format2 "Unexpected signature for monad \"%s\". Expected a signature of the form (a:Type -> WP a -> Effect); got %s" diff --git a/src/typechecker/FStar.TypeChecker.TcInductive.fst b/src/typechecker/FStar.TypeChecker.TcInductive.fst index bf4578b6073..b4dc322642f 100644 --- a/src/typechecker/FStar.TypeChecker.TcInductive.fst +++ b/src/typechecker/FStar.TypeChecker.TcInductive.fst @@ -412,8 +412,14 @@ let optimized_haseq_soundness_for_data (ty_lid:lident) (data:sigelt) (usubst:lis let haseq_b = mk_Tm_app U.t_haseq [S.as_arg b.binder_bv.sort] Range.dummyRange in //label the haseq predicate so that we get a proper error message if the assertion fails let sort_range = b.binder_bv.sort.pos in + let open FStar.Errors.Msg in + let open FStar.Pprint in + let open FStar.Class.PP in let haseq_b = TcUtil.label - (BU.format1 "Failed to prove that the type '%s' supports decidable equality because of this argument; add either the 'noeq' or 'unopteq' qualifier" (string_of_lid ty_lid)) + [ + text "Failed to prove that the type" ^/^ squotes (pp ty_lid) ^/^ text "supports decidable equality because of this argument."; + text "Add either the 'noeq' or 'unopteq' qualifier"; + ] sort_range haseq_b in diff --git a/src/typechecker/FStar.TypeChecker.TcTerm.fst b/src/typechecker/FStar.TypeChecker.TcTerm.fst index 53f9584497e..82ae15e0d7c 100644 --- a/src/typechecker/FStar.TypeChecker.TcTerm.fst +++ b/src/typechecker/FStar.TypeChecker.TcTerm.fst @@ -357,7 +357,7 @@ let check_expected_effect env (use_eq:bool) (copt:option comp) (ec : term * comp (Print.comp_to_string expected_c) (string_of_bool use_eq); let e, _, g = TcUtil.check_comp env use_eq e c expected_c in - let g = TcUtil.label_guard (Env.get_range env) "Could not prove post-condition" g in + let g = TcUtil.label_guard (Env.get_range env) (Errors.mkmsg "Could not prove post-condition") g in if debug env Options.Medium then BU.print2 "(%s) DONE check_expected_effect;\n\tguard is: %s\n" (Range.string_of_range e.pos) @@ -663,7 +663,7 @@ let guard_letrecs env actuals expected_c : list (lbname*typ*univ_names) = let precedes = let env = Env.push_binders env formals in mk_precedes env dec previous_dec in - let precedes = TcUtil.label "Could not prove termination of this recursive call" r precedes in + let precedes = TcUtil.label (Errors.mkmsg "Could not prove termination of this recursive call") r precedes in let bs, ({binder_bv=last; binder_positivity=pqual; binder_attrs=attrs; binder_qual=imp}) = BU.prefix formals in let last = {last with sort=U.refine last precedes} in let refined_formals = bs@[S.mk_binder_with_attrs last imp pqual attrs] in @@ -982,7 +982,7 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked let t, _, f = tc_check_tot_or_gtot_term env t k "" in let e, c, g = tc_term (Env.set_expected_typ_maybe_eq env t use_eq) e in //NS: Maybe redundant strengthen - let c, f = TcUtil.strengthen_precondition (Some (fun () -> return_all Err.ill_kinded_type)) (Env.set_range env t.pos) e c f in + let c, f = TcUtil.strengthen_precondition (Some (fun () -> Err.ill_kinded_type)) (Env.set_range env t.pos) e c f in let e, c, f2 = comp_check_expected_typ env (mk (Tm_ascribed {tm=e; asc=(Inl t, None, use_eq); eff_opt=Some c.eff_name}) top.pos) c in @@ -2194,7 +2194,7 @@ and tc_abs_check_binders env bs bs_expected use_eq let label_guard g = TcUtil.label_guard hd.sort.pos - "Type annotation on parameter incompatible with the expected type" + (Errors.mkmsg "Type annotation on parameter incompatible with the expected type") g in //cf issue #57 (the discussion at the end about subtyping vs. equality in check_binders) @@ -3979,7 +3979,7 @@ and check_inner_let env e = tc_term env_x e2 |> (fun (e2, c2, g2) -> let c2, g2 = TcUtil.strengthen_precondition - ((fun _ -> "folding guard g2 of e2 in the lcomp") |> Some) + ((fun _ -> Errors.mkmsg "folding guard g2 of e2 in the lcomp") |> Some) env_x e2 c2 diff --git a/src/typechecker/FStar.TypeChecker.Util.fst b/src/typechecker/FStar.TypeChecker.Util.fst index 29cc86c24f8..1a1628cbc97 100644 --- a/src/typechecker/FStar.TypeChecker.Util.fst +++ b/src/typechecker/FStar.TypeChecker.Util.fst @@ -1302,7 +1302,7 @@ let mk_bind env else mk_wp_bind env m ct1 b ct2 flags r1, Env.trivial_guard in c, Env.conj_guard g_lift g_bind -let strengthen_comp env (reason:option (unit -> string)) (c:comp) (f:formula) flags : comp * guard_t = +let strengthen_comp env (reason:option (unit -> list Pprint.document)) (c:comp) (f:formula) flags : comp * guard_t = if env.lax || Env.too_early_in_prims env then c, Env.trivial_guard else let r = Env.get_range env in @@ -1415,7 +1415,7 @@ let weaken_precondition env lc (f:guard_formula) : lcomp = TcComm.mk_lcomp lc.eff_name lc.res_typ (weaken_flags lc.cflags) weaken let strengthen_precondition - (reason:option (unit -> string)) + (reason:option (unit -> list Pprint.document)) env (e_for_debugging_only:term) (lc:lcomp) diff --git a/src/typechecker/FStar.TypeChecker.Util.fsti b/src/typechecker/FStar.TypeChecker.Util.fsti index 00cae991f5f..41ff4ed1e51 100644 --- a/src/typechecker/FStar.TypeChecker.Util.fsti +++ b/src/typechecker/FStar.TypeChecker.Util.fsti @@ -98,7 +98,7 @@ val bind_cases: env -> typ -> list (typ * lident * list cflag * (bool -> lcomp)) *) val weaken_result_typ: env -> term -> lcomp -> typ -> bool -> term * lcomp * guard_t -val strengthen_precondition: (option (unit -> string) -> env -> term -> lcomp -> guard_t -> lcomp*guard_t) +val strengthen_precondition: (option (unit -> list Pprint.document) -> env -> term -> lcomp -> guard_t -> lcomp*guard_t) val weaken_guard: guard_formula -> guard_formula -> guard_formula val weaken_precondition: env -> lcomp -> guard_formula -> lcomp val maybe_assume_result_eq_pure_term: env -> term -> lcomp -> lcomp @@ -132,8 +132,8 @@ val check_top_level: env -> guard_t -> lcomp -> bool*comp val maybe_coerce_lc : env -> term -> lcomp -> typ -> term * lcomp * guard_t //misc. -val label: string -> Range.range -> typ -> typ -val label_guard: Range.range -> string -> guard_t -> guard_t +val label: list Pprint.document -> Range.range -> typ -> typ +val label_guard: Range.range -> list Pprint.document -> guard_t -> guard_t val short_circuit: term -> args -> guard_formula val short_circuit_head: term -> bool val maybe_add_implicit_binders: env -> binders -> binders From 77fff34b8df17a51aef2aa1025b36a425d57767c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 28 Apr 2024 20:49:39 -0700 Subject: [PATCH 135/239] snap --- .../generated/FStar_SMTEncoding_EncodeTerm.ml | 45 ++++++++----- .../FStar_SMTEncoding_ErrorReporting.ml | 65 ++++++++++++------- .../generated/FStar_SMTEncoding_Solver.ml | 45 +++++++------ .../generated/FStar_SMTEncoding_Term.ml | 21 +++--- .../fstar-lib/generated/FStar_Syntax_Hash.ml | 11 +++- .../fstar-lib/generated/FStar_Syntax_Print.ml | 14 ++-- .../generated/FStar_Syntax_Resugar.ml | 10 ++- .../generated/FStar_Syntax_Syntax.ml | 8 ++- .../generated/FStar_Tactics_Hooks.ml | 46 +++++++------ .../generated/FStar_ToSyntax_ToSyntax.ml | 21 +++--- .../generated/FStar_TypeChecker_Err.ml | 31 ++++++--- .../FStar_TypeChecker_TcInductive.ml | 25 +++++-- .../generated/FStar_TypeChecker_TcTerm.ml | 25 ++++--- .../generated/FStar_TypeChecker_Util.ml | 13 ++-- 14 files changed, 244 insertions(+), 136 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml index d1348d87f7e..090e2c5224c 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml @@ -3695,27 +3695,38 @@ and (encode_formula : | (FStar_Pervasives_Native.Some r1, FStar_Pervasives_Native.Some s) -> let phi3 = - FStar_Syntax_Syntax.mk - (FStar_Syntax_Syntax.Tm_meta - { - FStar_Syntax_Syntax.tm2 = phi2; - FStar_Syntax_Syntax.meta = - (FStar_Syntax_Syntax.Meta_labeled - (s, r1, false)) - }) r1 in + let uu___4 = + let uu___5 = + let uu___6 = + let uu___7 = + let uu___8 = FStar_Errors_Msg.mkmsg s in + (uu___8, r1, false) in + FStar_Syntax_Syntax.Meta_labeled uu___7 in + { + FStar_Syntax_Syntax.tm2 = phi2; + FStar_Syntax_Syntax.meta = uu___6 + } in + FStar_Syntax_Syntax.Tm_meta uu___5 in + FStar_Syntax_Syntax.mk uu___4 r1 in fallback phi3 | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.Some s) -> let phi3 = - FStar_Syntax_Syntax.mk - (FStar_Syntax_Syntax.Tm_meta - { - FStar_Syntax_Syntax.tm2 = phi2; - FStar_Syntax_Syntax.meta = - (FStar_Syntax_Syntax.Meta_labeled - (s, (phi2.FStar_Syntax_Syntax.pos), - false)) - }) phi2.FStar_Syntax_Syntax.pos in + let uu___4 = + let uu___5 = + let uu___6 = + let uu___7 = + let uu___8 = FStar_Errors_Msg.mkmsg s in + (uu___8, (phi2.FStar_Syntax_Syntax.pos), + false) in + FStar_Syntax_Syntax.Meta_labeled uu___7 in + { + FStar_Syntax_Syntax.tm2 = phi2; + FStar_Syntax_Syntax.meta = uu___6 + } in + FStar_Syntax_Syntax.Tm_meta uu___5 in + FStar_Syntax_Syntax.mk uu___4 + phi2.FStar_Syntax_Syntax.pos in fallback phi3 | uu___4 -> fallback phi2) | (FStar_Syntax_Syntax.Tm_fvar fv, (t, uu___)::[]) when diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_ErrorReporting.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_ErrorReporting.ml index 9d52f5c3985..b3897210935 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_ErrorReporting.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_ErrorReporting.ml @@ -11,7 +11,7 @@ let (__proj__Not_a_wp_implication__item__uu___ : Prims.exn -> Prims.string) = fun projectee -> match projectee with | Not_a_wp_implication uu___ -> uu___ let (sort_labels : (FStar_SMTEncoding_Term.error_label * Prims.bool) Prims.list -> - ((FStar_SMTEncoding_Term.fv * Prims.string * + ((FStar_SMTEncoding_Term.fv * FStar_Errors_Msg.error_message * FStar_Compiler_Range_Type.range) * Prims.bool) Prims.list) = fun l -> @@ -23,7 +23,7 @@ let (sort_labels : -> FStar_Compiler_Range_Ops.compare r1 r2) l let (remove_dups : labels -> - (FStar_SMTEncoding_Term.fv * Prims.string * + (FStar_SMTEncoding_Term.fv * FStar_Errors_Msg.error_message * FStar_Compiler_Range_Type.range) Prims.list) = fun l -> @@ -40,7 +40,7 @@ type ranges = let (__ctr : Prims.int FStar_Compiler_Effect.ref) = FStar_Compiler_Util.mk_ref Prims.int_zero let (fresh_label : - Prims.string -> + FStar_Errors_Msg.error_message -> FStar_Compiler_Range_Type.range -> FStar_SMTEncoding_Term.term -> (label * FStar_SMTEncoding_Term.term)) = @@ -104,17 +104,23 @@ let (label_goals : FStar_Compiler_Util.for_some is_guard_free (conjuncts lhs) in let uu___ = match use_env_msg with - | FStar_Pervasives_Native.None -> (false, "") + | FStar_Pervasives_Native.None -> (false, FStar_Pprint.empty) | FStar_Pervasives_Native.Some f -> - let uu___1 = f () in (true, uu___1) in + let uu___1 = + let uu___2 = f () in FStar_Pprint.doc_of_string uu___2 in + (true, uu___1) in match uu___ with | (flag, msg_prefix) -> let fresh_label1 msg1 ropt rng t = let msg2 = if flag then - Prims.strcat "Failed to verify implicit argument: " - (Prims.strcat msg_prefix (Prims.strcat " :: " msg1)) + let uu___1 = + let uu___2 = + FStar_Errors_Msg.text + "Failed to verify implicit argument: " in + FStar_Pprint.op_Hat_Hat uu___2 msg_prefix in + uu___1 :: msg1 else msg1 in let rng1 = match ropt with @@ -138,8 +144,9 @@ let (label_goals : | FStar_SMTEncoding_Term.Real uu___1 -> (labels1, q1) | FStar_SMTEncoding_Term.LblPos uu___1 -> FStar_Compiler_Effect.failwith "Impossible" - | FStar_SMTEncoding_Term.Labeled - (arg, "Could not prove post-condition", label_range) -> + | FStar_SMTEncoding_Term.Labeled (arg, d::[], label_range) when + let uu___1 = FStar_Errors_Msg.renderdoc d in + uu___1 = "Could not prove post-condition" -> let fallback debug_msg = aux default_msg (FStar_Pervasives_Native.Some label_range) @@ -233,8 +240,10 @@ let (label_goals : if uu___7 then let uu___8 = - aux - "Could not prove post-condition" + let uu___9 = + FStar_Errors_Msg.mkmsg + "Could not prove post-condition" in + aux uu___9 FStar_Pervasives_Native.None (FStar_Pervasives_Native.Some post_name) @@ -744,8 +753,9 @@ let (label_goals : q1.FStar_SMTEncoding_Term.rng in (labels2, uu___2)) in (FStar_Compiler_Effect.op_Colon_Equals __ctr Prims.int_zero; - aux "Assertion failed" FStar_Pervasives_Native.None - FStar_Pervasives_Native.None [] q) + (let uu___2 = FStar_Errors_Msg.mkmsg "Assertion failed" in + aux uu___2 FStar_Pervasives_Native.None + FStar_Pervasives_Native.None [] q)) let (detail_errors : Prims.bool -> FStar_TypeChecker_Env.env -> @@ -785,21 +795,32 @@ let (detail_errors : else if hint_replay then - FStar_Errors.log_issue r - (FStar_Errors_Codes.Warning_HintFailedToReplayProof, - (Prims.strcat - "Hint failed to replay this sub-proof: " msg1)) + (let uu___3 = + let uu___4 = + let uu___5 = + FStar_Errors_Msg.text + "Hint failed to replay this sub-proof" in + uu___5 :: msg1 in + (FStar_Errors_Codes.Warning_HintFailedToReplayProof, + uu___4) in + FStar_Errors.log_issue_doc r uu___3) else (let uu___4 = let uu___5 = let uu___6 = - FStar_Compiler_Range_Ops.string_of_range r in - FStar_Compiler_Util.format2 - "XX: proof obligation at %s failed\n\t%s\n" uu___6 - msg1 in + let uu___7 = + let uu___8 = + let uu___9 = + FStar_Class_Show.show + FStar_Compiler_Range_Ops.show_range r in + FStar_Compiler_Util.format1 + "XX: proof obligation at %s failed." uu___9 in + FStar_Errors_Msg.text uu___8 in + [uu___7] in + FStar_Compiler_List.op_At uu___6 msg1 in (FStar_Errors_Codes.Error_ProofObligationFailed, uu___5) in - FStar_Errors.log_issue r uu___4) in + FStar_Errors.log_issue_doc r uu___4) in let elim labs = FStar_Compiler_List.map (fun uu___ -> diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml index 3c94ee482b1..0f14fb2829c 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml @@ -631,10 +631,9 @@ let (query_errors : (fun uu___3 -> match uu___3 with | (uu___4, x, y) -> - let uu___5 = FStar_Errors_Msg.mkmsg x in - let uu___6 = FStar_Errors.get_ctx () in - (FStar_Errors_Codes.Error_Z3SolverError, uu___5, - y, uu___6)) error_labels in + let uu___5 = FStar_Errors.get_ctx () in + (FStar_Errors_Codes.Error_Z3SolverError, x, y, + uu___5)) error_labels in { error_reason = msg; error_fuel = (settings.query_fuel); @@ -821,9 +820,8 @@ let (errors_to_report : | (FStar_Pervasives_Native.None, (uu___1, msg, rng)::[]) -> let uu___2 = let uu___3 = - let uu___4 = FStar_Errors_Msg.mkmsg msg in - let uu___5 = FStar_Errors.get_ctx () in - (FStar_Errors_Codes.Error_Z3SolverError, uu___4, rng, uu___5) in + let uu___4 = FStar_Errors.get_ctx () in + (FStar_Errors_Codes.Error_Z3SolverError, msg, rng, uu___4) in [uu___3] in FStar_TypeChecker_Err.errors_smt_detail settings.query_env uu___2 recovery_failed_msg @@ -840,10 +838,14 @@ let (errors_to_report : ("", FStar_SMTEncoding_Term.dummy_sort) in let msg = let uu___3 = - FStar_Syntax_Print.term_to_string settings.query_term in - FStar_Compiler_Util.format1 - "Failed to prove the following goal, although it appears to be trivial: %s" - uu___3 in + let uu___4 = + FStar_Errors_Msg.text + "Failed to prove the following goal, although it appears to be trivial:" in + let uu___5 = + FStar_Class_PP.pp FStar_Syntax_Print.pretty_term + settings.query_term in + FStar_Pprint.op_Hat_Slash_Hat uu___4 uu___5 in + [uu___3] in let range = FStar_TypeChecker_Env.get_range settings.query_env in [(dummy_fv, msg, range)] @@ -870,10 +872,9 @@ let (errors_to_report : | (uu___4, msg, rng) -> let uu___5 = let uu___6 = - let uu___7 = FStar_Errors_Msg.mkmsg msg in - let uu___8 = FStar_Errors.get_ctx () in - (FStar_Errors_Codes.Error_Z3SolverError, uu___7, - rng, uu___8) in + let uu___7 = FStar_Errors.get_ctx () in + (FStar_Errors_Codes.Error_Z3SolverError, msg, + rng, uu___7) in [uu___6] in FStar_TypeChecker_Err.errors_smt_detail settings.query_env uu___5 recovery_failed_msg) @@ -1140,13 +1141,17 @@ let (query_info : query_settings -> FStar_SMTEncoding_Z3.z3result -> unit) = (fun uu___5 -> match uu___5 with | (uu___6, msg, range1) -> - let tag1 = + let msg1 = if used_hint settings - then "(Hint-replay failed): " - else "" in - FStar_Errors.log_issue range1 + then + let uu___7 = + FStar_Pprint.doc_of_string + "Hint-replay failed" in + uu___7 :: msg + else msg in + FStar_Errors.log_issue_doc range1 (FStar_Errors_Codes.Warning_HitReplayFailed, - (Prims.strcat tag1 msg))) errs)) + msg1)) errs)) else () let (store_hint : FStar_Compiler_Hints.hint -> unit) = fun hint -> diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml index ddfeca71d0c..b661b4802aa 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml @@ -166,7 +166,8 @@ type term' = | Quant of (qop * term Prims.list Prims.list * Prims.int FStar_Pervasives_Native.option * sort Prims.list * term) | Let of (term Prims.list * term) - | Labeled of (term * Prims.string * FStar_Compiler_Range_Type.range) + | Labeled of (term * FStar_Errors_Msg.error_message * + FStar_Compiler_Range_Type.range) | LblPos of (term * Prims.string) and term = { @@ -213,8 +214,9 @@ let (__proj__Let__item___0 : term' -> (term Prims.list * term)) = let (uu___is_Labeled : term' -> Prims.bool) = fun projectee -> match projectee with | Labeled _0 -> true | uu___ -> false let (__proj__Labeled__item___0 : - term' -> (term * Prims.string * FStar_Compiler_Range_Type.range)) = - fun projectee -> match projectee with | Labeled _0 -> _0 + term' -> + (term * FStar_Errors_Msg.error_message * FStar_Compiler_Range_Type.range)) + = fun projectee -> match projectee with | Labeled _0 -> _0 let (uu___is_LblPos : term' -> Prims.bool) = fun projectee -> match projectee with | LblPos _0 -> true | uu___ -> false let (__proj__LblPos__item___0 : term' -> (term * Prims.string)) = @@ -523,7 +525,8 @@ let (fv_sort : fv -> sort) = let (fv_force : fv -> Prims.bool) = fun x -> let uu___ = x in match uu___ with | FV (uu___1, uu___2, force) -> force -type error_label = (fv * Prims.string * FStar_Compiler_Range_Type.range) +type error_label = + (fv * FStar_Errors_Msg.error_message * FStar_Compiler_Range_Type.range) type error_labels = error_label Prims.list let (fv_eq : fv -> fv -> Prims.bool) = fun x -> @@ -665,8 +668,9 @@ let rec (hash_of_term' : term' -> Prims.string) = | Labeled (t1, r1, r2) -> let uu___ = hash_of_term t1 in let uu___1 = - let uu___2 = FStar_Compiler_Range_Ops.string_of_range r2 in - Prims.strcat r1 uu___2 in + let uu___2 = FStar_Errors_Msg.rendermsg r1 in + let uu___3 = FStar_Compiler_Range_Ops.string_of_range r2 in + Prims.strcat uu___2 uu___3 in Prims.strcat uu___ uu___1 | LblPos (t1, r) -> let uu___ = @@ -1089,8 +1093,9 @@ let rec (print_smt_term : term -> Prims.string) = let uu___1 = print_smt_term_list l in FStar_Compiler_Util.format2 "(%s %s)" uu___ uu___1 | Labeled (t1, r1, r2) -> - let uu___ = print_smt_term t1 in - FStar_Compiler_Util.format2 "(Labeled '%s' %s)" r1 uu___ + let uu___ = FStar_Errors_Msg.rendermsg r1 in + let uu___1 = print_smt_term t1 in + FStar_Compiler_Util.format2 "(Labeled '%s' %s)" uu___ uu___1 | LblPos (t1, s) -> let uu___ = print_smt_term t1 in FStar_Compiler_Util.format2 "(LblPos %s %s)" s uu___ diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Hash.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Hash.ml index f4ee30207aa..70fca371d54 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Hash.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Hash.ml @@ -83,6 +83,15 @@ let hash_option : let uu___1 = FStar_Hash.of_int (Prims.of_int (1249)) in ret uu___1 in let uu___1 = h o1 in mix uu___ uu___1 +let (hash_doc : FStar_Pprint.document -> FStar_Hash.hash_code mm) = + fun d -> + let uu___ = + FStar_Pprint.pretty_string (FStar_Compiler_Util.float_of_string "1.0") + (Prims.of_int (80)) d in + of_string uu___ +let (hash_doc_list : + FStar_Pprint.document Prims.list -> FStar_Hash.hash_code mm) = + fun ds -> hash_list hash_doc ds let hash_pair : 'a 'b . ('a -> FStar_Hash.hash_code mm) -> @@ -579,7 +588,7 @@ and (hash_meta : FStar_Syntax_Syntax.metadata -> FStar_Hash.hash_code mm) = let uu___1 = let uu___2 = of_int (Prims.of_int (1031)) in let uu___3 = - let uu___4 = of_string s in + let uu___4 = hash_doc_list s in let uu___5 = let uu___6 = let uu___7 = FStar_Compiler_Range_Ops.string_of_range r in diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml index 930a25fe49b..793bb50b226 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml @@ -417,10 +417,11 @@ and (term_to_string : FStar_Syntax_Syntax.term -> Prims.string) = FStar_Syntax_Syntax.meta = FStar_Syntax_Syntax.Meta_labeled (l, r, b);_} -> - let uu___3 = FStar_Compiler_Range_Ops.string_of_range r in - let uu___4 = term_to_string t in - FStar_Compiler_Util.format3 "Meta_labeled(%s, %s){%s}" l - uu___3 uu___4 + let uu___3 = FStar_Errors_Msg.rendermsg l in + let uu___4 = FStar_Compiler_Range_Ops.string_of_range r in + let uu___5 = term_to_string t in + FStar_Compiler_Util.format3 "Meta_labeled(%s, %s){%s}" uu___3 + uu___4 uu___5 | FStar_Syntax_Syntax.Tm_meta { FStar_Syntax_Syntax.tm2 = t; FStar_Syntax_Syntax.meta = FStar_Syntax_Syntax.Meta_named l;_} @@ -1111,8 +1112,9 @@ and (metadata_to_string : FStar_Syntax_Syntax.metadata -> Prims.string) = let uu___1 = sli lid in FStar_Compiler_Util.format1 "{Meta_named %s}" uu___1 | FStar_Syntax_Syntax.Meta_labeled (l, r, uu___1) -> - let uu___2 = FStar_Compiler_Range_Ops.string_of_range r in - FStar_Compiler_Util.format2 "{Meta_labeled (%s, %s)}" l uu___2 + let uu___2 = FStar_Errors_Msg.rendermsg l in + let uu___3 = FStar_Compiler_Range_Ops.string_of_range r in + FStar_Compiler_Util.format2 "{Meta_labeled (%s, %s)}" uu___2 uu___3 | FStar_Syntax_Syntax.Meta_desugared msi -> "{Meta_desugared}" | FStar_Syntax_Syntax.Meta_monadic (m, t) -> let uu___1 = sli m in diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml index 32baefc20fd..ada658eb397 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml @@ -1035,9 +1035,13 @@ let rec (resugar_term' : | FStar_Syntax_Syntax.Meta_labeled (s, r, p) -> let uu___9 = - mk - (FStar_Parser_AST.Labeled - (body3, s, p)) in + let uu___10 = + let uu___11 = + let uu___12 = + FStar_Errors_Msg.rendermsg s in + (body3, uu___12, p) in + FStar_Parser_AST.Labeled uu___11 in + mk uu___10 in ([], uu___9) | uu___9 -> FStar_Compiler_Effect.failwith diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml index b103a7cec3e..cb73ad57f8b 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml @@ -337,8 +337,8 @@ and metadata = | Meta_pattern of (term' syntax Prims.list * (term' syntax * arg_qualifier FStar_Pervasives_Native.option) Prims.list Prims.list) | Meta_named of FStar_Ident.lident - | Meta_labeled of (Prims.string * FStar_Compiler_Range_Type.range * - Prims.bool) + | Meta_labeled of (FStar_Pprint.document Prims.list * + FStar_Compiler_Range_Type.range * Prims.bool) | Meta_desugared of meta_source_info | Meta_monadic of (monad_name * term' syntax) | Meta_monadic_lift of (monad_name * monad_name * term' syntax) @@ -847,7 +847,9 @@ let (uu___is_Meta_labeled : metadata -> Prims.bool) = fun projectee -> match projectee with | Meta_labeled _0 -> true | uu___ -> false let (__proj__Meta_labeled__item___0 : - metadata -> (Prims.string * FStar_Compiler_Range_Type.range * Prims.bool)) + metadata -> + (FStar_Pprint.document Prims.list * FStar_Compiler_Range_Type.range * + Prims.bool)) = fun projectee -> match projectee with | Meta_labeled _0 -> _0 let (uu___is_Meta_desugared : metadata -> Prims.bool) = fun projectee -> diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml index 33dae4e4ca6..0c00a3092ad 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml @@ -649,26 +649,31 @@ let (preprocess : (let label = let uu___7 = let uu___8 = - FStar_Class_Show.show - (FStar_Class_Show.printableshow - FStar_Class_Printable.printable_int) - n in + FStar_Pprint.doc_of_string + "Could not prove goal #" in let uu___9 = let uu___10 = - let uu___11 = - FStar_Tactics_Types.get_label g in - uu___11 = "" in - if uu___10 - then "" - else - (let uu___12 = - let uu___13 = - FStar_Tactics_Types.get_label g in - Prims.strcat uu___13 ")" in - Prims.strcat " (" uu___12) in - Prims.strcat uu___8 uu___9 in - Prims.strcat "Could not prove goal #" - uu___7 in + FStar_Class_PP.pp + FStar_Class_PP.pp_int n in + let uu___11 = + let uu___12 = + let uu___13 = + FStar_Tactics_Types.get_label g in + uu___13 = "" in + if uu___12 + then FStar_Pprint.empty + else + (let uu___14 = + let uu___15 = + FStar_Tactics_Types.get_label + g in + FStar_Pprint.doc_of_string + uu___15 in + FStar_Pprint.parens uu___14) in + FStar_Pprint.op_Hat_Slash_Hat uu___10 + uu___11 in + FStar_Pprint.op_Hat_Hat uu___8 uu___9 in + [uu___7] in let gt' = let uu___7 = FStar_Tactics_Types.goal_range g in @@ -695,7 +700,7 @@ let (preprocess : (did_anything, uu___7))))) let rec (traverse_for_spinoff : pol -> - (Prims.string * FStar_Compiler_Range_Type.range) + (FStar_Pprint.document Prims.list * FStar_Compiler_Range_Type.range) FStar_Pervasives_Native.option -> FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> tres) = @@ -716,8 +721,9 @@ let rec (traverse_for_spinoff : FStar_Compiler_Range_Ops.string_of_def_range rng in let uu___2 = FStar_Compiler_Range_Ops.string_of_use_range rng in + let uu___3 = FStar_Errors_Msg.rendermsg msg in FStar_Compiler_Util.format3 "(%s,%s) : %s" uu___1 uu___2 - msg in + uu___3 in if debug then (let uu___1 = diff --git a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml index 959617fa399..5ca71a19413 100644 --- a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml +++ b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml @@ -6005,14 +6005,19 @@ and (desugar_formula : match uu___ with | FStar_Parser_AST.Labeled (f1, l, p) -> let f2 = desugar_formula env f1 in - mk - (FStar_Syntax_Syntax.Tm_meta - { - FStar_Syntax_Syntax.tm2 = f2; - FStar_Syntax_Syntax.meta = - (FStar_Syntax_Syntax.Meta_labeled - (l, (f2.FStar_Syntax_Syntax.pos), p)) - }) + let uu___1 = + let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = FStar_Errors_Msg.mkmsg l in + (uu___5, (f2.FStar_Syntax_Syntax.pos), p) in + FStar_Syntax_Syntax.Meta_labeled uu___4 in + { + FStar_Syntax_Syntax.tm2 = f2; + FStar_Syntax_Syntax.meta = uu___3 + } in + FStar_Syntax_Syntax.Tm_meta uu___2 in + mk uu___1 | FStar_Parser_AST.QForall ([], uu___1, uu___2) -> FStar_Compiler_Effect.failwith "Impossible: Quantifier without binders" diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml index b287d9b06ff..6a5a1fa6a26 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml @@ -219,23 +219,36 @@ let (err_msg_comp_strings : fun c2 -> print_discrepancy (FStar_TypeChecker_Normalize.comp_to_string env) c1 c2 -let (exhaustiveness_check : Prims.string) = "Patterns are incomplete" +let (exhaustiveness_check : FStar_Pprint.document Prims.list) = + let uu___ = FStar_Errors_Msg.text "Patterns are incomplete" in [uu___] let (subtyping_failed : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.typ -> - FStar_Syntax_Syntax.typ -> unit -> Prims.string) + FStar_Syntax_Syntax.typ -> unit -> FStar_Errors_Msg.error_message) = fun env -> fun t1 -> fun t2 -> fun uu___ -> - let uu___1 = err_msg_type_strings env t1 t2 in - match uu___1 with - | (s1, s2) -> - FStar_Compiler_Util.format2 - "Subtyping check failed; expected type %s; got type %s" s2 s1 -let (ill_kinded_type : Prims.string) = "Ill-kinded type" -let (totality_check : Prims.string) = "This term may not terminate" + let ppt = FStar_TypeChecker_Normalize.term_to_doc env in + let uu___1 = FStar_Errors_Msg.text "Subtyping check failed" in + let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = FStar_Errors_Msg.text "Expected type" in + let uu___6 = ppt t2 in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one uu___5 + uu___6 in + let uu___5 = + let uu___6 = FStar_Errors_Msg.text "got type" in + let uu___7 = ppt t1 in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one uu___6 + uu___7 in + FStar_Pprint.op_Hat_Slash_Hat uu___4 uu___5 in + [uu___3] in + uu___1 :: uu___2 +let (ill_kinded_type : FStar_Errors_Msg.error_message) = + FStar_Errors_Msg.mkmsg "Ill-kinded type" let (unexpected_signature_for_monad : FStar_TypeChecker_Env.env -> FStar_Ident.lident -> diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml index 58240a147d0..94816b95c80 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml @@ -1299,10 +1299,27 @@ let (optimized_haseq_soundness_for_data : ((b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort).FStar_Syntax_Syntax.pos in let haseq_b1 = let uu___2 = - let uu___3 = FStar_Ident.string_of_lid ty_lid in - FStar_Compiler_Util.format1 - "Failed to prove that the type '%s' supports decidable equality because of this argument; add either the 'noeq' or 'unopteq' qualifier" - uu___3 in + let uu___3 = + let uu___4 = + FStar_Errors_Msg.text + "Failed to prove that the type" in + let uu___5 = + let uu___6 = + let uu___7 = + FStar_Class_PP.pp + FStar_Ident.pretty_lident ty_lid in + FStar_Pprint.squotes uu___7 in + let uu___7 = + FStar_Errors_Msg.text + "supports decidable equality because of this argument." in + FStar_Pprint.op_Hat_Slash_Hat uu___6 uu___7 in + FStar_Pprint.op_Hat_Slash_Hat uu___4 uu___5 in + let uu___4 = + let uu___5 = + FStar_Errors_Msg.text + "Add either the 'noeq' or 'unopteq' qualifier" in + [uu___5] in + uu___3 :: uu___4 in FStar_TypeChecker_Util.label uu___2 sort_range haseq_b in FStar_Syntax_Util.mk_conj t haseq_b1) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml index 5852a96f007..3946271c045 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml @@ -809,9 +809,11 @@ let (check_expected_effect : let g1 = let uu___10 = FStar_TypeChecker_Env.get_range env in + let uu___11 = + FStar_Errors_Msg.mkmsg + "Could not prove post-condition" in FStar_TypeChecker_Util.label_guard - uu___10 - "Could not prove post-condition" g in + uu___10 uu___11 g in ((let uu___11 = FStar_TypeChecker_Env.debug env FStar_Options.Medium in @@ -1606,9 +1608,10 @@ let (guard_letrecs : FStar_TypeChecker_Env.push_binders env1 formals1 in mk_precedes env2 dec previous_dec in let precedes1 = - FStar_TypeChecker_Util.label - "Could not prove termination of this recursive call" - r precedes in + let uu___3 = + FStar_Errors_Msg.mkmsg + "Could not prove termination of this recursive call" in + FStar_TypeChecker_Util.label uu___3 r precedes in let uu___3 = FStar_Compiler_Util.prefix formals1 in match uu___3 with | (bs, @@ -2639,8 +2642,7 @@ and (tc_maybe_toplevel_term : FStar_TypeChecker_Util.strengthen_precondition (FStar_Pervasives_Native.Some (fun uu___9 -> - FStar_Compiler_Util.return_all - FStar_TypeChecker_Err.ill_kinded_type)) + FStar_TypeChecker_Err.ill_kinded_type)) uu___8 e2 c f in (match uu___7 with | (c1, f1) -> @@ -6067,10 +6069,12 @@ and (tc_abs_check_binders : | (t, uu___8, g1_env) -> let g2_env = let label_guard g = + let uu___9 = + FStar_Errors_Msg.mkmsg + "Type annotation on parameter incompatible with the expected type" in FStar_TypeChecker_Util.label_guard (hd.FStar_Syntax_Syntax.sort).FStar_Syntax_Syntax.pos - "Type annotation on parameter incompatible with the expected type" - g in + uu___9 g in let uu___9 = FStar_TypeChecker_Rel.teq_nosmt env1 t expected_t in @@ -10699,7 +10703,8 @@ and (check_inner_let : FStar_TypeChecker_Util.strengthen_precondition (FStar_Pervasives_Native.Some (fun uu___7 -> - "folding guard g2 of e2 in the lcomp")) + FStar_Errors_Msg.mkmsg + "folding guard g2 of e2 in the lcomp")) env_x e22 c2 g2 in (match uu___6 with | (c21, g21) -> (e22, c21, g21)) in (match uu___4 with diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml index 3c638a5388f..605de0d7a17 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml @@ -861,7 +861,7 @@ let (mk_wp_return : else ()); c let (label : - Prims.string -> + FStar_Pprint.document Prims.list -> FStar_Compiler_Range_Type.range -> FStar_Syntax_Syntax.typ -> FStar_Syntax_Syntax.typ) = @@ -877,7 +877,8 @@ let (label : }) f.FStar_Syntax_Syntax.pos let (label_opt : FStar_TypeChecker_Env.env -> - (unit -> Prims.string) FStar_Pervasives_Native.option -> + (unit -> FStar_Pprint.document Prims.list) FStar_Pervasives_Native.option + -> FStar_Compiler_Range_Type.range -> FStar_Syntax_Syntax.typ -> FStar_Syntax_Syntax.typ) = @@ -896,7 +897,7 @@ let (label_opt : else (let uu___2 = reason1 () in label uu___2 r f) let (label_guard : FStar_Compiler_Range_Type.range -> - Prims.string -> + FStar_Pprint.document Prims.list -> FStar_TypeChecker_Env.guard_t -> FStar_TypeChecker_Env.guard_t) = fun r -> @@ -2794,7 +2795,8 @@ let (mk_bind : (c, uu___5))))) let (strengthen_comp : FStar_TypeChecker_Env.env -> - (unit -> Prims.string) FStar_Pervasives_Native.option -> + (unit -> FStar_Pprint.document Prims.list) FStar_Pervasives_Native.option + -> FStar_Syntax_Syntax.comp -> FStar_Syntax_Syntax.formula -> FStar_Syntax_Syntax.cflag Prims.list -> @@ -2982,7 +2984,8 @@ let (weaken_precondition : lc.FStar_TypeChecker_Common.eff_name lc.FStar_TypeChecker_Common.res_typ uu___ weaken let (strengthen_precondition : - (unit -> Prims.string) FStar_Pervasives_Native.option -> + (unit -> FStar_Pprint.document Prims.list) FStar_Pervasives_Native.option + -> FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> FStar_TypeChecker_Common.lcomp -> From 970526f724589c2d30735cf67be7e3fa7c2a1b5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 28 Apr 2024 20:51:25 -0700 Subject: [PATCH 136/239] Update expected output --- tests/error-messages/ArrowRanges.fst.expected | 8 +++-- tests/error-messages/Calc.fst.expected | 15 ++++++--- tests/error-messages/Coercions.fst.expected | 15 ++++++--- tests/error-messages/Inference.fst.expected | 6 ++-- .../NegativeTests.BST.fst.expected | 32 ++++++++++++------- .../NegativeTests.Bug260.fst.expected | 3 +- .../NegativeTests.Neg.fst.expected | 17 +++++++--- ...NegativeTests.ShortCircuiting.fst.expected | 3 +- ...NegativeTests.ZZImplicitFalse.fst.expected | 3 +- tests/error-messages/PatAnnot.fst.expected | 9 ++++-- ...Test.FunctionalExtensionality.fst.expected | 9 ++++-- .../TestErrorLocations.fst.expected | 26 ++++++++++----- tests/error-messages/TestHasEq.fst.expected | 8 +++-- .../backtracking.refinements.out.expected | 16 +++++----- .../emacs/integration.push-pop.out.expected | 8 ++--- ...r.interface-violation-and-fix.out.expected | 2 +- .../number.interface-violation.out.expected | 2 +- 17 files changed, 119 insertions(+), 63 deletions(-) diff --git a/tests/error-messages/ArrowRanges.fst.expected b/tests/error-messages/ArrowRanges.fst.expected index 71a4fea738e..a9e8c9b3356 100644 --- a/tests/error-messages/ArrowRanges.fst.expected +++ b/tests/error-messages/ArrowRanges.fst.expected @@ -1,6 +1,7 @@ >> Got issues: [ * Error 19 at ArrowRanges.fst(4,30-4,39): - - Subtyping check failed; expected type Prims.eqtype; got type Type0 + - Subtyping check failed + - Expected type Prims.eqtype got type Type0 - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(52,23-52,30) @@ -8,7 +9,10 @@ >>] >> Got issues: [ * Error 19 at ArrowRanges.fst(8,10-8,28): - - Failed to prove that the type 'ArrowRanges.ppof' supports decidable equality because of this argument; add either the 'noeq' or 'unopteq' qualifier + - Failed to prove that the type + 'ArrowRanges.ppof' + supports decidable equality because of this argument. + - Add either the 'noeq' or 'unopteq' qualifier - The SMT solver could not prove the query. Use --query_stats for more details. - See also ArrowRanges.fst(7,0-11,1) diff --git a/tests/error-messages/Calc.fst.expected b/tests/error-messages/Calc.fst.expected index 4e25b314bd7..b9a0da83c63 100644 --- a/tests/error-messages/Calc.fst.expected +++ b/tests/error-messages/Calc.fst.expected @@ -33,7 +33,8 @@ >>] >> Got issues: [ * Error 19 at Calc.fst(51,6-51,8): - - Subtyping check failed; expected type Prims.squash (1 == 2); got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash (1 == 2) got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also Calc.fst(51,3-51,5) @@ -41,7 +42,8 @@ >>] >> Got issues: [ * Error 19 at Calc.fst(65,6-65,8): - - Subtyping check failed; expected type Prims.squash (2 == 3); got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash (2 == 3) got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also Calc.fst(65,3-65,5) @@ -49,7 +51,8 @@ >>] >> Got issues: [ * Error 19 at Calc.fst(79,6-79,8): - - Subtyping check failed; expected type Prims.squash (3 == 4); got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash (3 == 4) got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also Calc.fst(79,3-79,5) @@ -57,7 +60,8 @@ >>] >> Got issues: [ * Error 19 at Calc.fst(93,42-93,44): - - Subtyping check failed; expected type Prims.squash q; got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash q got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also Calc.fst(91,20-91,21) @@ -65,7 +69,8 @@ >>] >> Got issues: [ * Error 19 at Calc.fst(100,10-100,12): - - Subtyping check failed; expected type Prims.squash q; got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash q got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also Calc.fst(101,4-101,5) diff --git a/tests/error-messages/Coercions.fst.expected b/tests/error-messages/Coercions.fst.expected index 57e39193959..97a2a36f3b7 100644 --- a/tests/error-messages/Coercions.fst.expected +++ b/tests/error-messages/Coercions.fst.expected @@ -10,7 +10,8 @@ >>] >> Got issues: [ * Error 19 at Coercions.fst(71,4-71,8): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) @@ -18,7 +19,8 @@ >>] >> Got issues: [ * Error 19 at Coercions.fst(74,49-74,57): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) @@ -26,7 +28,8 @@ >>] >> Got issues: [ * Error 19 at Coercions.fst(76,55-76,56): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) @@ -34,7 +37,8 @@ >>] >> Got issues: [ * Error 19 at Coercions.fst(78,50-78,51): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) @@ -42,7 +46,8 @@ >>] >> Got issues: [ * Error 19 at Coercions.fst(80,51-80,52): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) diff --git a/tests/error-messages/Inference.fst.expected b/tests/error-messages/Inference.fst.expected index 90ad5402cb0..397a012e95d 100644 --- a/tests/error-messages/Inference.fst.expected +++ b/tests/error-messages/Inference.fst.expected @@ -1,12 +1,14 @@ >> Got issues: [ * Error 19 at Inference.fst(20,14-20,15): - - Subtyping check failed; expected type Prims.eqtype; got type Type0 + - Subtyping check failed + - Expected type Prims.eqtype got type Type0 - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(52,23-52,30) * Error 19 at Inference.fst(20,14-20,15): - - Subtyping check failed; expected type Prims.eqtype; got type Type0 + - Subtyping check failed + - Expected type Prims.eqtype got type Type0 - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(52,23-52,30) diff --git a/tests/error-messages/NegativeTests.BST.fst.expected b/tests/error-messages/NegativeTests.BST.fst.expected index 1ef5ca9a56c..64915039088 100644 --- a/tests/error-messages/NegativeTests.BST.fst.expected +++ b/tests/error-messages/NegativeTests.BST.fst.expected @@ -1,8 +1,12 @@ >> Got issues: [ * Error 19 at NegativeTests.BST.fst(37,38-37,42): - - Subtyping check failed; expected type right: - FStar.Pervasives.Native.option (tree 2) - {0 <= 1 /\ 1 <= 2 /\ None? right == (1 = 2) /\ None? FStar.Pervasives.Native.None == (1 = 0)}; got type FStar.Pervasives.Native.option (tree 2) + - Subtyping check failed + - Expected type + right: + FStar.Pervasives.Native.option (tree 2) + { 0 <= 1 /\ 1 <= 2 /\ None? right == (1 = 2) /\ + None? FStar.Pervasives.Native.None == (1 = 0) } + got type FStar.Pervasives.Native.option (tree 2) - The SMT solver could not prove the query. Use --query_stats for more details. - See also NegativeTests.BST.fst(27,36-27,58) @@ -10,10 +14,13 @@ >>] >> Got issues: [ * Error 19 at NegativeTests.BST.fst(40,61-40,65): - - Subtyping check failed; expected type right: - FStar.Pervasives.Native.option (tree (l + 1)) - { l <= l /\ l <= l + 1 /\ None? right == (l = l + 1) /\ - None? (FStar.Pervasives.Native.Some t) == (l = l) }; got type FStar.Pervasives.Native.option (tree (l + 1)) + - Subtyping check failed + - Expected type + right: + FStar.Pervasives.Native.option (tree (l + 1)) + { l <= l /\ l <= l + 1 /\ None? right == (l = l + 1) /\ + None? (FStar.Pervasives.Native.Some t) == (l = l) } + got type FStar.Pervasives.Native.option (tree (l + 1)) - The SMT solver could not prove the query. Use --query_stats for more details. - See also NegativeTests.BST.fst(27,36-27,58) @@ -21,10 +28,13 @@ >>] >> Got issues: [ * Error 19 at NegativeTests.BST.fst(43,78-43,87): - - Subtyping check failed; expected type right: - FStar.Pervasives.Native.option (tree (l + 1)) - { l <= l + 1 /\ l + 1 <= l + 1 /\ None? right == (l + 1 = l + 1) /\ - None? (FStar.Pervasives.Native.Some t1) == (l + 1 = l) }; got type FStar.Pervasives.Native.option (tree (l + 1)) + - Subtyping check failed + - Expected type + right: + FStar.Pervasives.Native.option (tree (l + 1)) + { l <= l + 1 /\ l + 1 <= l + 1 /\ None? right == (l + 1 = l + 1) /\ + None? (FStar.Pervasives.Native.Some t1) == (l + 1 = l) } + got type FStar.Pervasives.Native.option (tree (l + 1)) - The SMT solver could not prove the query. Use --query_stats for more details. - See also NegativeTests.BST.fst(27,36-27,58) diff --git a/tests/error-messages/NegativeTests.Bug260.fst.expected b/tests/error-messages/NegativeTests.Bug260.fst.expected index 1a052c517e1..fcc0b4cd296 100644 --- a/tests/error-messages/NegativeTests.Bug260.fst.expected +++ b/tests/error-messages/NegativeTests.Bug260.fst.expected @@ -1,6 +1,7 @@ >> Got issues: [ * Error 19 at NegativeTests.Bug260.fst(26,12-26,19): - - Subtyping check failed; expected type validity (S (S t)); got type validity (S t) + - Subtyping check failed + - Expected type validity (S (S t)) got type validity (S t) - The SMT solver could not prove the query. Use --query_stats for more details. - See also NegativeTests.Bug260.fst(23,37-26,9) diff --git a/tests/error-messages/NegativeTests.Neg.fst.expected b/tests/error-messages/NegativeTests.Neg.fst.expected index 29e31b0711a..d0795e5626f 100644 --- a/tests/error-messages/NegativeTests.Neg.fst.expected +++ b/tests/error-messages/NegativeTests.Neg.fst.expected @@ -1,6 +1,7 @@ >> Got issues: [ * Error 19 at NegativeTests.Neg.fst(20,8-20,10): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) @@ -8,7 +9,8 @@ >>] >> Got issues: [ * Error 19 at NegativeTests.Neg.fst(24,8-24,10): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) @@ -46,7 +48,9 @@ >>] >> Got issues: [ * Error 19 at NegativeTests.Neg.fst(46,30-46,31): - - Subtyping check failed; expected type _: FStar.Pervasives.Native.option 'a {Some? _}; got type FStar.Pervasives.Native.option 'a + - Subtyping check failed + - Expected type _: FStar.Pervasives.Native.option 'a {Some? _} + got type FStar.Pervasives.Native.option 'a - The SMT solver could not prove the query. Use --query_stats for more details. - See also FStar.Pervasives.Native.fst(33,4-33,8) @@ -54,7 +58,9 @@ >>] >> Got issues: [ * Error 19 at NegativeTests.Neg.fst(50,45-50,47): - - Subtyping check failed; expected type _: FStar.Pervasives.result Prims.int {V? _}; got type FStar.Pervasives.result Prims.int + - Subtyping check failed + - Expected type _: FStar.Pervasives.result Prims.int {V? _} + got type FStar.Pervasives.result Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also FStar.Pervasives.fsti(519,4-519,5) @@ -62,7 +68,8 @@ >>] >> Got issues: [ * Error 19 at NegativeTests.Neg.fst(55,25-55,26): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) diff --git a/tests/error-messages/NegativeTests.ShortCircuiting.fst.expected b/tests/error-messages/NegativeTests.ShortCircuiting.fst.expected index 41dccb71c77..5b635f71949 100644 --- a/tests/error-messages/NegativeTests.ShortCircuiting.fst.expected +++ b/tests/error-messages/NegativeTests.ShortCircuiting.fst.expected @@ -1,6 +1,7 @@ >> Got issues: [ * Error 19 at NegativeTests.ShortCircuiting.fst(21,16-21,33): - - Subtyping check failed; expected type b: Prims.bool{bad_p b}; got type Prims.bool + - Subtyping check failed + - Expected type b: Prims.bool{bad_p b} got type Prims.bool - The SMT solver could not prove the query. Use --query_stats for more details. - See also NegativeTests.ShortCircuiting.fst(19,31-19,38) diff --git a/tests/error-messages/NegativeTests.ZZImplicitFalse.fst.expected b/tests/error-messages/NegativeTests.ZZImplicitFalse.fst.expected index cf9a8d8e810..0d67288c4b1 100644 --- a/tests/error-messages/NegativeTests.ZZImplicitFalse.fst.expected +++ b/tests/error-messages/NegativeTests.ZZImplicitFalse.fst.expected @@ -1,6 +1,7 @@ >> Got issues: [ * Error 19 at NegativeTests.ZZImplicitFalse.fst(20,27-20,28): - - Subtyping check failed; expected type Prims.l_False; got type Prims.unit + - Subtyping check failed + - Expected type Prims.l_False got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(138,29-138,34) diff --git a/tests/error-messages/PatAnnot.fst.expected b/tests/error-messages/PatAnnot.fst.expected index b4f19cac357..1f8012c1479 100644 --- a/tests/error-messages/PatAnnot.fst.expected +++ b/tests/error-messages/PatAnnot.fst.expected @@ -1,6 +1,7 @@ >> Got issues: [ * Error 19 at PatAnnot.fst(25,8-25,9): - - Subtyping check failed; expected type Prims.squash Prims.l_False; got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash Prims.l_False got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also PatAnnot.fst(25,19-25,24) @@ -24,7 +25,8 @@ >>] >> Got issues: [ * Error 19 at PatAnnot.fst(39,10-39,12): - - Subtyping check failed; expected type Prims.squash Prims.l_False; got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash Prims.l_False got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also PatAnnot.fst(40,26-40,31) @@ -32,7 +34,8 @@ >>] >> Got issues: [ * Error 19 at PatAnnot.fst(46,10-46,11): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) diff --git a/tests/error-messages/Test.FunctionalExtensionality.fst.expected b/tests/error-messages/Test.FunctionalExtensionality.fst.expected index e9ec96e0ab5..fe6acd56d3c 100644 --- a/tests/error-messages/Test.FunctionalExtensionality.fst.expected +++ b/tests/error-messages/Test.FunctionalExtensionality.fst.expected @@ -1,6 +1,7 @@ >> Got issues: [ * Error 19 at Test.FunctionalExtensionality.fst(36,49-36,50): - - Subtyping check failed; expected type Prims.nat ^-> Prims.int; got type Prims.int ^-> Prims.int + - Subtyping check failed + - Expected type Prims.nat ^-> Prims.int got type Prims.int ^-> Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also FStar.FunctionalExtensionality.fsti(102,60-102,77) @@ -16,7 +17,8 @@ >>] >> Got issues: [ * Error 19 at Test.FunctionalExtensionality.fst(92,36-92,47): - - Subtyping check failed; expected type _: Prims.int -> Prims.int; got type Prims.nat ^-> Prims.int + - Subtyping check failed + - Expected type _: Prims.int -> Prims.int got type Prims.nat ^-> Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) @@ -24,7 +26,8 @@ >>] >> Got issues: [ * Error 19 at Test.FunctionalExtensionality.fst(142,57-142,58): - - Subtyping check failed; expected type Prims.int ^-> Prims.int; got type Prims.int ^-> Prims.nat + - Subtyping check failed + - Expected type Prims.int ^-> Prims.int got type Prims.int ^-> Prims.nat - The SMT solver could not prove the query. Use --query_stats for more details. - See also FStar.FunctionalExtensionality.fsti(102,60-102,77) diff --git a/tests/error-messages/TestErrorLocations.fst.expected b/tests/error-messages/TestErrorLocations.fst.expected index f8145bd0165..055a9d33019 100644 --- a/tests/error-messages/TestErrorLocations.fst.expected +++ b/tests/error-messages/TestErrorLocations.fst.expected @@ -30,7 +30,8 @@ >>] >> Got issues: [ * Error 19 at TestErrorLocations.fst(43,20-43,21): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) @@ -62,7 +63,8 @@ >>] >> Got issues: [ * Error 19 at TestErrorLocations.fst(66,27-66,28): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) @@ -70,7 +72,8 @@ >>] >> Got issues: [ * Error 19 at TestErrorLocations.fst(70,25-70,34): - - Subtyping check failed; expected type Type0; got type Type0 + - Subtyping check failed + - Expected type Type0 got type Type0 - The SMT solver could not prove the query. Use --query_stats for more details. - See also TestErrorLocations.fst(68,52-68,66) @@ -78,7 +81,9 @@ >>] >> Got issues: [ * Error 19 at TestErrorLocations.fst(89,20-89,36): - - Subtyping check failed; expected type Prims.squash (exists (x: Prims.nat). x = 0); got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash (exists (x: Prims.nat). x = 0) + got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also FStar.Classical.Sugar.fsti(66,22-66,41) @@ -86,14 +91,17 @@ >>] >> Got issues: [ * Error 19 at TestErrorLocations.fst(97,28-97,33): - - Subtyping check failed; expected type Prims.squash (forall (x: Prims.nat). x = 0); got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash (forall (x: Prims.nat). x = 0) + got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. >>] >> Got issues: [ * Error 19 at TestErrorLocations.fst(102,12-102,13): - - Subtyping check failed; expected type Prims.squash (p /\ q); got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash (p /\ q) got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also TestErrorLocations.fst(101,19-101,20) @@ -101,7 +109,8 @@ >>] >> Got issues: [ * Error 19 at TestErrorLocations.fst(108,17-108,18): - - Subtyping check failed; expected type Prims.squash (p /\ q); got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash (p /\ q) got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also TestErrorLocations.fst(107,21-107,22) @@ -109,7 +118,8 @@ >>] >> Got issues: [ * Error 19 at TestErrorLocations.fst(114,12-114,18): - - Subtyping check failed; expected type Prims.squash (p \/ q); got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash (p \/ q) got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also FStar.Classical.Sugar.fsti(88,21-88,31) diff --git a/tests/error-messages/TestHasEq.fst.expected b/tests/error-messages/TestHasEq.fst.expected index 18365287095..5a272c71d6b 100644 --- a/tests/error-messages/TestHasEq.fst.expected +++ b/tests/error-messages/TestHasEq.fst.expected @@ -1,6 +1,9 @@ >> Got issues: [ * Error 19 at TestHasEq.fst(58,10-58,11): - - Failed to prove that the type 'TestHasEq.t3' supports decidable equality because of this argument; add either the 'noeq' or 'unopteq' qualifier + - Failed to prove that the type + 'TestHasEq.t3' + supports decidable equality because of this argument. + - Add either the 'noeq' or 'unopteq' qualifier - The SMT solver could not prove the query. Use --query_stats for more details. - See also TestHasEq.fst(57,0-58,19) @@ -8,7 +11,8 @@ >>] >> Got issues: [ * Error 19 at TestHasEq.fst(84,10-84,70): - - Subtyping check failed; expected type Prims.eqtype; got type Type0 + - Subtyping check failed + - Expected type Prims.eqtype got type Type0 - The SMT solver could not prove the query. Use --query_stats for more details. - See also TestHasEq.fst(84,12-84,22) diff --git a/tests/ide/emacs/backtracking.refinements.out.expected b/tests/ide/emacs/backtracking.refinements.out.expected index feeab41a808..6a9f18a6c67 100644 --- a/tests/ide/emacs/backtracking.refinements.out.expected +++ b/tests/ide/emacs/backtracking.refinements.out.expected @@ -16,15 +16,15 @@ {"kind": "response", "query-id": "15", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [3, 15], "end": [3, 15], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "16", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [3, 15], "end": [3, 15], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "17", "response": [], "status": "success"} -{"kind": "response", "query-id": "18", "response": [{"level": "error", "message": " - Subtyping check failed; expected type a: nat{a > 2}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 24], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "18", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type a: nat{a > 2} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 24], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "19", "response": [], "status": "success"} {"kind": "response", "query-id": "20", "response": [], "status": "success"} -{"kind": "response", "query-id": "21", "response": [{"level": "error", "message": " - Subtyping check failed; expected type a: nat{a > 1}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 24], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "21", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type a: nat{a > 1} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 24], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "22", "response": [], "status": "success"} {"kind": "response", "query-id": "23", "response": [], "status": "success"} {"kind": "response", "query-id": "24", "response": null, "status": "success"} {"kind": "response", "query-id": "25", "response": [], "status": "success"} -{"kind": "response", "query-id": "26", "response": [{"level": "error", "message": " - Subtyping check failed; expected type a: nat{a > 0}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 25], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "26", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type a: nat{a > 0} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 25], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "27", "response": [], "status": "success"} {"kind": "response", "query-id": "28", "response": [], "status": "success"} {"kind": "response", "query-id": "29", "response": [], "status": "success"} @@ -43,7 +43,7 @@ {"kind": "response", "query-id": "42", "response": [], "status": "success"} {"kind": "response", "query-id": "43", "response": [], "status": "success"} {"kind": "response", "query-id": "44", "response": [], "status": "success"} -{"kind": "response", "query-id": "45", "response": [{"level": "error", "message": " - Subtyping check failed; expected type b: nat{b > 1}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (5,13-5,18)\n", "number": 19, "ranges": [{"beg": [5, 22], "end": [5, 31], "fname": ""}, {"beg": [5, 13], "end": [5, 18], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "45", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type b: nat{b > 1} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (5,13-5,18)\n", "number": 19, "ranges": [{"beg": [5, 22], "end": [5, 31], "fname": ""}, {"beg": [5, 13], "end": [5, 18], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "46", "response": [], "status": "success"} {"kind": "response", "query-id": "47", "response": [], "status": "success"} {"kind": "response", "query-id": "48", "response": [], "status": "success"} @@ -53,7 +53,7 @@ {"kind": "response", "query-id": "52", "response": [], "status": "success"} {"kind": "response", "query-id": "53", "response": null, "status": "success"} {"kind": "response", "query-id": "54", "response": [], "status": "success"} -{"kind": "response", "query-id": "55", "response": [{"level": "error", "message": " - Subtyping check failed; expected type b: nat{b > 1}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (5,13-5,18)\n", "number": 19, "ranges": [{"beg": [5, 22], "end": [5, 31], "fname": ""}, {"beg": [5, 13], "end": [5, 18], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "55", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type b: nat{b > 1} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (5,13-5,18)\n", "number": 19, "ranges": [{"beg": [5, 22], "end": [5, 31], "fname": ""}, {"beg": [5, 13], "end": [5, 18], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "56", "response": null, "status": "success"} {"kind": "response", "query-id": "57", "response": [], "status": "success"} {"kind": "response", "query-id": "58", "response": [], "status": "success"} @@ -61,12 +61,12 @@ {"kind": "response", "query-id": "60", "response": null, "status": "success"} {"kind": "response", "query-id": "61", "response": null, "status": "success"} {"kind": "response", "query-id": "62", "response": [], "status": "success"} -{"kind": "response", "query-id": "63", "response": [{"level": "error", "message": " - Subtyping check failed; expected type a: nat{a > 0}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 25], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "63", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type a: nat{a > 0} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 25], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "64", "response": [], "status": "success"} -{"kind": "response", "query-id": "65", "response": [{"level": "error", "message": " - Subtyping check failed; expected type a: nat{a > 0}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 24], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "65", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type a: nat{a > 0} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 24], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "66", "response": [], "status": "success"} {"kind": "response", "query-id": "67", "response": [], "status": "success"} -{"kind": "response", "query-id": "68", "response": [{"level": "error", "message": " - Subtyping check failed; expected type b: nat{b > 1}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (5,13-5,18)\n", "number": 19, "ranges": [{"beg": [5, 22], "end": [5, 31], "fname": ""}, {"beg": [5, 13], "end": [5, 18], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "68", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type b: nat{b > 1} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (5,13-5,18)\n", "number": 19, "ranges": [{"beg": [5, 22], "end": [5, 31], "fname": ""}, {"beg": [5, 13], "end": [5, 18], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "69", "response": null, "status": "success"} {"kind": "response", "query-id": "70", "response": [], "status": "success"} {"kind": "response", "query-id": "71", "response": [], "status": "success"} diff --git a/tests/ide/emacs/integration.push-pop.out.expected b/tests/ide/emacs/integration.push-pop.out.expected index 0e073ecfc6b..67ba0e83bb4 100644 --- a/tests/ide/emacs/integration.push-pop.out.expected +++ b/tests/ide/emacs/integration.push-pop.out.expected @@ -78,17 +78,17 @@ {"kind": "response", "query-id": "80", "response": [], "status": "success"} {"kind": "response", "query-id": "91", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [12, 0], "end": [12, 0], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "98", "response": [], "status": "success"} -{"kind": "response", "query-id": "101", "response": [{"level": "error", "message": " - Subtyping check failed; expected type nat; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} +{"kind": "response", "query-id": "101", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type nat got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} {"kind": "response", "query-id": "107", "response": [], "status": "success"} {"kind": "response", "query-id": "108", "response": [], "status": "success"} {"kind": "response", "query-id": "112", "response": null, "status": "success"} {"kind": "response", "query-id": "114", "response": [], "status": "success"} -{"kind": "response", "query-id": "116", "response": [{"level": "error", "message": " - Subtyping check failed; expected type nat; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} +{"kind": "response", "query-id": "116", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type nat got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} {"kind": "response", "query-id": "118", "response": [], "status": "success"} {"kind": "response", "query-id": "119", "response": [], "status": "success"} {"kind": "response", "query-id": "122", "response": null, "status": "success"} {"kind": "response", "query-id": "124", "response": [], "status": "success"} -{"kind": "response", "query-id": "126", "response": [{"level": "error", "message": " - Subtyping check failed; expected type nat; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} +{"kind": "response", "query-id": "126", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type nat got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} {"kind": "response", "query-id": "128", "response": [], "status": "success"} {"kind": "response", "query-id": "130", "response": [], "status": "success"} {"kind": "response", "query-id": "133", "response": [], "status": "success"} @@ -106,7 +106,7 @@ {"kind": "response", "query-id": "191", "response": null, "status": "success"} {"kind": "response", "query-id": "192", "response": null, "status": "success"} {"kind": "response", "query-id": "194", "response": [], "status": "success"} -{"kind": "response", "query-id": "198", "response": [{"level": "error", "message": " - Subtyping check failed; expected type nat; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} +{"kind": "response", "query-id": "198", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type nat got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} {"kind": "response", "query-id": "200", "response": [], "status": "success"} {"kind": "response", "query-id": "204", "response": [], "status": "success"} {"kind": "response", "query-id": "205", "response": [{"level": "error", "message": " - Assertion failed\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (13,15-13,23)\n", "number": 19, "ranges": [{"beg": [13, 8], "end": [13, 14], "fname": ""}, {"beg": [13, 15], "end": [13, 23], "fname": ""}]}], "status": "failure"} diff --git a/tests/ide/emacs/number.interface-violation-and-fix.out.expected b/tests/ide/emacs/number.interface-violation-and-fix.out.expected index 939ccd8db80..781916a9e28 100644 --- a/tests/ide/emacs/number.interface-violation-and-fix.out.expected +++ b/tests/ide/emacs/number.interface-violation-and-fix.out.expected @@ -1,7 +1,7 @@ {"kind": "protocol-info", "rest": "[...]"} {"kind": "response", "query-id": "1", "response": null, "status": "success"} {"kind": "response", "query-id": "2", "response": [], "status": "success"} -{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": " - Subtyping check failed; expected type a: int{a > 0}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also number.fsti(18,14-18,19)\n", "number": 19, "ranges": [{"beg": [3, 8], "end": [3, 10], "fname": ""}, {"beg": [18, 14], "end": [18, 19], "fname": "number.fsti"}]}], "status": "failure"} +{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type a: int{a > 0} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also number.fsti(18,14-18,19)\n", "number": 19, "ranges": [{"beg": [3, 8], "end": [3, 10], "fname": ""}, {"beg": [18, 14], "end": [18, 19], "fname": "number.fsti"}]}], "status": "failure"} {"kind": "response", "query-id": "4", "response": null, "status": "success"} {"kind": "response", "query-id": "5", "response": null, "status": "success"} {"kind": "response", "query-id": "6", "response": [], "status": "success"} diff --git a/tests/ide/emacs/number.interface-violation.out.expected b/tests/ide/emacs/number.interface-violation.out.expected index 69bdd3bd2c8..80448802552 100644 --- a/tests/ide/emacs/number.interface-violation.out.expected +++ b/tests/ide/emacs/number.interface-violation.out.expected @@ -1,4 +1,4 @@ {"kind": "protocol-info", "rest": "[...]"} {"kind": "response", "query-id": "1", "response": null, "status": "success"} {"kind": "response", "query-id": "2", "response": [], "status": "success"} -{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": " - Subtyping check failed; expected type a: int{a > 0}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also number.fsti(18,14-18,19)\n", "number": 19, "ranges": [{"beg": [3, 8], "end": [3, 10], "fname": ""}, {"beg": [18, 14], "end": [18, 19], "fname": "number.fsti"}]}], "status": "failure"} +{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type a: int{a > 0} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also number.fsti(18,14-18,19)\n", "number": 19, "ranges": [{"beg": [3, 8], "end": [3, 10], "fname": ""}, {"beg": [18, 14], "end": [18, 19], "fname": "number.fsti"}]}], "status": "failure"} From 85a5dbcfbb9bf3d8d36d0074724a4b199a3194fc Mon Sep 17 00:00:00 2001 From: Aseem Rastogi Date: Mon, 29 Apr 2024 06:18:07 +0000 Subject: [PATCH 137/239] some cleanup --- .../generated/FStar_Tactics_Hooks.ml | 67 +++++++++++-------- src/tactics/FStar.Tactics.Hooks.fst | 34 ++++++---- 2 files changed, 59 insertions(+), 42 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml index a4f1e52d556..11af4ebe0fe 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml @@ -1769,6 +1769,15 @@ let (handle_smt_goal : uu___7) gs1)) in gs | FStar_Pervasives_Native.None -> [(env, goal1)]) +let (uu___844 : + FStar_Syntax_Syntax.term FStar_Syntax_Embeddings_Base.embedding) = + FStar_Reflection_V2_Embeddings.e_term +type blob_t = + (Prims.string * FStar_Syntax_Syntax.term) FStar_Pervasives_Native.option +type dsl_typed_sigelt_t = (Prims.bool * FStar_Syntax_Syntax.sigelt * blob_t) +type dsl_tac_result_t = + (dsl_typed_sigelt_t Prims.list * dsl_typed_sigelt_t * dsl_typed_sigelt_t + Prims.list) let (splice : FStar_TypeChecker_Env.env -> Prims.bool -> @@ -1815,11 +1824,6 @@ let (splice : (FStar_Compiler_List.length lids) > Prims.int_one then - let s = - let uu___7 = - FStar_Compiler_List.map - FStar_Ident.string_of_lid lids in - FStar_Compiler_Util.concat_l ", " uu___7 in let uu___7 = let uu___8 = let uu___9 = @@ -1870,11 +1874,6 @@ let (splice : else FStar_Pervasives_Native.Some tval) in - let e_blob = - FStar_Syntax_Embeddings.e_option - (FStar_Syntax_Embeddings.e_tuple2 - FStar_Syntax_Embeddings.e_string - FStar_Reflection_V2_Embeddings.e_term) in let uu___8 = FStar_Tactics_Interpreter.run_tactic_on_ps tau1.FStar_Syntax_Syntax.pos @@ -1882,7 +1881,7 @@ let (splice : (FStar_Syntax_Embeddings.e_tuple2 FStar_Reflection_V2_Embeddings.e_env (FStar_Syntax_Embeddings.e_option - FStar_Reflection_V2_Embeddings.e_term)) + uu___844)) ({ FStar_TypeChecker_Env.solver = (env.FStar_TypeChecker_Env.solver); @@ -2012,62 +2011,72 @@ let (splice : (FStar_Syntax_Embeddings.e_tuple3 FStar_Syntax_Embeddings.e_bool FStar_Reflection_V2_Embeddings.e_sigelt - e_blob)) + (FStar_Syntax_Embeddings.e_option + (FStar_Syntax_Embeddings.e_tuple2 + FStar_Syntax_Embeddings.e_string + uu___844)))) (FStar_Syntax_Embeddings.e_tuple3 FStar_Syntax_Embeddings.e_bool FStar_Reflection_V2_Embeddings.e_sigelt - e_blob) + (FStar_Syntax_Embeddings.e_option + (FStar_Syntax_Embeddings.e_tuple2 + FStar_Syntax_Embeddings.e_string + uu___844))) (FStar_Syntax_Embeddings.e_list (FStar_Syntax_Embeddings.e_tuple3 FStar_Syntax_Embeddings.e_bool FStar_Reflection_V2_Embeddings.e_sigelt - e_blob))) tau1 + (FStar_Syntax_Embeddings.e_option + (FStar_Syntax_Embeddings.e_tuple2 + FStar_Syntax_Embeddings.e_string + uu___844))))) tau1 tactic_already_typed ps in match uu___8 with | (gs, (sig_blobs_before, sig_blob, sig_blobs_after)) -> + let uu___9 = uu___8 in let sig_blobs = FStar_Compiler_List.op_At sig_blobs_before (sig_blob :: sig_blobs_after) in let sigelts = FStar_Compiler_List.map - (fun uu___9 -> - match uu___9 with + (fun uu___10 -> + match uu___10 with | (checked, se, blob_opt) -> - let uu___10 = - let uu___11 = - se.FStar_Syntax_Syntax.sigmeta in + let uu___11 = let uu___12 = + se.FStar_Syntax_Syntax.sigmeta in + let uu___13 = match blob_opt with | FStar_Pervasives_Native.Some (s, blob) -> - let uu___13 = - let uu___14 = + let uu___14 = + let uu___15 = FStar_Compiler_Dyn.mkdyn blob in - (s, uu___14) in - [uu___13] + (s, uu___15) in + [uu___14] | FStar_Pervasives_Native.None -> [] in { FStar_Syntax_Syntax.sigmeta_active = - (uu___11.FStar_Syntax_Syntax.sigmeta_active); + (uu___12.FStar_Syntax_Syntax.sigmeta_active); FStar_Syntax_Syntax.sigmeta_fact_db_ids = - (uu___11.FStar_Syntax_Syntax.sigmeta_fact_db_ids); + (uu___12.FStar_Syntax_Syntax.sigmeta_fact_db_ids); FStar_Syntax_Syntax.sigmeta_admit = - (uu___11.FStar_Syntax_Syntax.sigmeta_admit); + (uu___12.FStar_Syntax_Syntax.sigmeta_admit); FStar_Syntax_Syntax.sigmeta_spliced = - (uu___11.FStar_Syntax_Syntax.sigmeta_spliced); + (uu___12.FStar_Syntax_Syntax.sigmeta_spliced); FStar_Syntax_Syntax.sigmeta_already_checked = checked; FStar_Syntax_Syntax.sigmeta_extension_data - = uu___12 + = uu___13 } in { FStar_Syntax_Syntax.sigel @@ -2080,7 +2089,7 @@ let (splice : = (se.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta - = uu___10; + = uu___11; FStar_Syntax_Syntax.sigattrs = (se.FStar_Syntax_Syntax.sigattrs); diff --git a/src/tactics/FStar.Tactics.Hooks.fst b/src/tactics/FStar.Tactics.Hooks.fst index 5787d5bccbd..b10dbe06ab5 100644 --- a/src/tactics/FStar.Tactics.Hooks.fst +++ b/src/tactics/FStar.Tactics.Hooks.fst @@ -817,6 +817,16 @@ let handle_smt_goal env goal = (* No such tactic was available in the current context *) | None -> [env, goal] +// TODO: this is somehow needed for tcresolve to infer the embeddings in run_tactic_on_ps below +instance _ = RE.e_term + +type blob_t = option (string & term) +type dsl_typed_sigelt_t = bool & sigelt & blob_t +type dsl_tac_result_t = + list dsl_typed_sigelt_t & + dsl_typed_sigelt_t & + list dsl_typed_sigelt_t + let splice (env:Env.env) (is_typed:bool) @@ -845,8 +855,7 @@ let splice // See if there is a val for the lid // if List.length lids > 1 - then let s = lids |> List.map Ident.string_of_lid |> BU.concat_l ", " in - Err.raise_error + then Err.raise_error (Errors.Error_BadSplice, BU.format1 "Typed splice: unexpected lids length (> 1) (%s)" (show lids)) rng @@ -873,20 +882,19 @@ let splice (string_of_int (List.length uvs))) rng else Some tval in - let e_blob = e_option (e_tuple2 e_string RE.e_term) in + // // The arguments to run_tactic_on_ps here are in sync with ulib/FStar.Tactics.dsl_tac_t // - let gs, (sig_blobs_before, sig_blob, sig_blobs_after) = run_tactic_on_ps tau.pos tau.pos false - (e_tuple2 RE.e_env (e_option RE.e_term)) - ({env with gamma=[]}, val_t) - (e_tuple3 - (e_list (e_tuple3 e_bool RE.e_sigelt e_blob)) - (e_tuple3 e_bool RE.e_sigelt e_blob) - (e_list (e_tuple3 e_bool RE.e_sigelt e_blob))) - tau - tactic_already_typed - ps + let (gs, (sig_blobs_before, sig_blob, sig_blobs_after)) + : list goal & dsl_tac_result_t = + run_tactic_on_ps tau.pos tau.pos false + FStar.Tactics.Typeclasses.solve + ({env with gamma=[]}, val_t) + FStar.Tactics.Typeclasses.solve + tau + tactic_already_typed + ps in let sig_blobs = sig_blobs_before@(sig_blob::sig_blobs_after) in let sigelts = sig_blobs |> map (fun (checked, se, blob_opt) -> From f89eae64e03e8d2c260080f461f2990778fa8a1c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 26 Apr 2024 17:23:24 -0700 Subject: [PATCH 138/239] FStar.Compiler.Debug: introduce extensible debugging module It allows to get a reference to each debug toggle statically, during program initialization, to later query in constant time. --- src/basic/FStar.Compiler.Debug.fst | 68 +++++++++++++++++++++++++++++ src/basic/FStar.Compiler.Debug.fsti | 55 +++++++++++++++++++++++ 2 files changed, 123 insertions(+) create mode 100644 src/basic/FStar.Compiler.Debug.fst create mode 100644 src/basic/FStar.Compiler.Debug.fsti diff --git a/src/basic/FStar.Compiler.Debug.fst b/src/basic/FStar.Compiler.Debug.fst new file mode 100644 index 00000000000..e15cca57957 --- /dev/null +++ b/src/basic/FStar.Compiler.Debug.fst @@ -0,0 +1,68 @@ +(* + Copyright 2008-2020 Microsoft Research + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + +module FStar.Compiler.Debug + +module BU = FStar.Compiler.Util + +let toggle_list : ref (list (string & ref bool)) = + BU.mk_ref [] + +let register_toggle (k : string) : ref bool = + let r = BU.mk_ref false in + toggle_list := (k, r) :: !toggle_list; + r + +let get_toggle (k : string) : ref bool = + match List.tryFind (fun (k', _) -> k = k') !toggle_list with + | Some (_, r) -> r + | None -> register_toggle k + +let list_all_toggles () : list string = + List.map fst !toggle_list + +let anyref = BU.mk_ref false +let any () = !anyref +let enable () = anyref := true + +let dbg_level = BU.mk_ref 0 + +let low () = !dbg_level >= 1 +let medium () = !dbg_level >= 2 +let high () = !dbg_level >= 3 +let extreme () = !dbg_level >= 4 + +let set_level_low () = dbg_level := 1 +let set_level_medium () = dbg_level := 2 +let set_level_high () = dbg_level := 3 +let set_level_extreme () = dbg_level := 4 + +let enable_toggles (keys : list string) : unit = + if Cons? keys then enable (); + keys |> List.iter (fun k -> + if k = "Low" then set_level_low () + else if k = "Medium" then set_level_medium () + else if k = "High" then set_level_high () + else if k = "Extreme" then set_level_extreme () + else + let t = get_toggle k in + t := true + ) + +let disable_all () : unit = + anyref := false; + dbg_level := 0; + List.iter (fun (_, r) -> r := false) !toggle_list diff --git a/src/basic/FStar.Compiler.Debug.fsti b/src/basic/FStar.Compiler.Debug.fsti new file mode 100644 index 00000000000..eba7439f83e --- /dev/null +++ b/src/basic/FStar.Compiler.Debug.fsti @@ -0,0 +1,55 @@ +(* + Copyright 2008-2020 Microsoft Research + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + +module FStar.Compiler.Debug + +open FStar +open FStar.Compiler +open FStar.Compiler.Effect + +(* Enable debugging. *) +val enable () : unit + +(* Are we doing *any* kind of debugging? *) +val any () : bool + +(* Obtain the toggle for a given debug key *) +val get_toggle (k : string) : ref bool + +(* List all registered toggles *) +val list_all_toggles () : list string + +(* Vanilla debug levels. Each level implies the previous lower one. *) +val low () : bool +val medium () : bool +val high () : bool +val extreme () : bool + +(* Enable a list of debug toggles. If will also call enable() +is key is non-empty, and will recognize "Low", "Medium", +"High", "Extreme" as special and call the corresponding +set_level_* function. *) +val enable_toggles (keys : list string) : unit + +(* Sets the debug level to zero and sets all registered toggles +to false. any() will return false after this. *) +val disable_all () : unit + +(* Not used externally at the moment. *) +val set_level_low () : unit +val set_level_medium () : unit +val set_level_high () : unit +val set_level_extreme () : unit From 0c11a02f376216e3f920e8c5fe07f0fbbe87c12a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 27 Apr 2024 10:23:16 -0700 Subject: [PATCH 139/239] Using FStar.Debug --- ocaml/fstar-lib/FStar_Parser_ParseIt.ml | 4 +- ocaml/fstar-lib/FStar_Tactics_Load.ml | 4 +- ocaml/fstar-lib/FStar_Tactics_Native.ml | 4 +- src/basic/FStar.Errors.fst | 7 +- src/basic/FStar.Options.fst | 47 ++-- src/basic/FStar.Options.fsti | 26 +- src/extraction/FStar.Extraction.ML.Modul.fst | 14 +- src/extraction/FStar.Extraction.ML.RegEmb.fst | 4 +- src/extraction/FStar.Extraction.ML.Term.fst | 8 +- src/extraction/FStar.Extraction.ML.UEnv.fst | 3 +- src/fstar/FStar.CheckedFiles.fst | 16 +- src/fstar/FStar.Interactive.Ide.fst | 10 +- src/fstar/FStar.Interactive.Incremental.fst | 2 +- src/fstar/FStar.Interactive.Legacy.fst | 2 +- src/fstar/FStar.Main.fst | 2 +- src/fstar/FStar.Universal.fst | 3 +- src/parser/FStar.Parser.Dep.fst | 20 +- src/smtencoding/FStar.SMTEncoding.Encode.fst | 47 ++-- .../FStar.SMTEncoding.EncodeTerm.fst | 32 ++- src/smtencoding/FStar.SMTEncoding.Env.fst | 4 +- src/smtencoding/FStar.SMTEncoding.Solver.fst | 4 +- src/smtencoding/FStar.SMTEncoding.Z3.fst | 4 +- src/syntax/FStar.Syntax.Compress.fst | 4 +- src/syntax/FStar.Syntax.Hash.fst | 2 +- src/tactics/FStar.Tactics.Hooks.fst | 44 ++- src/tactics/FStar.Tactics.Interpreter.fst | 23 +- src/tactics/FStar.Tactics.Interpreter.fsti | 3 - src/tactics/FStar.Tactics.Monad.fst | 15 +- src/tactics/FStar.Tactics.Printing.fst | 4 +- src/tactics/FStar.Tactics.V1.Basic.fst | 24 +- src/tactics/FStar.Tactics.V2.Basic.fst | 29 +- src/tests/FStar.Tests.Norm.fst | 2 +- src/tests/FStar.Tests.Unif.fst | 1 - src/tosyntax/FStar.ToSyntax.ToSyntax.fst | 8 +- src/typechecker/FStar.TypeChecker.Cfg.fst | 72 ++--- src/typechecker/FStar.TypeChecker.Core.fst | 34 +-- src/typechecker/FStar.TypeChecker.DMFF.fst | 22 +- src/typechecker/FStar.TypeChecker.Env.fst | 12 +- src/typechecker/FStar.TypeChecker.Env.fsti | 1 - .../FStar.TypeChecker.Generalize.fst | 24 +- src/typechecker/FStar.TypeChecker.NBE.fst | 9 +- .../FStar.TypeChecker.Normalize.fst | 11 +- .../FStar.TypeChecker.PatternUtils.fst | 4 +- .../FStar.TypeChecker.Positivity.fst | 10 +- src/typechecker/FStar.TypeChecker.Rel.fst | 255 +++++++++--------- src/typechecker/FStar.TypeChecker.Tc.fst | 77 +++--- .../FStar.TypeChecker.TcEffect.fst | 55 ++-- .../FStar.TypeChecker.TcInductive.fst | 21 +- src/typechecker/FStar.TypeChecker.TcTerm.fst | 140 +++++----- src/typechecker/FStar.TypeChecker.Util.fst | 106 ++++---- 50 files changed, 668 insertions(+), 611 deletions(-) diff --git a/ocaml/fstar-lib/FStar_Parser_ParseIt.ml b/ocaml/fstar-lib/FStar_Parser_ParseIt.ml index b6c970def2e..f3ec9aad461 100644 --- a/ocaml/fstar-lib/FStar_Parser_ParseIt.ml +++ b/ocaml/fstar-lib/FStar_Parser_ParseIt.ml @@ -65,7 +65,7 @@ let read_physical_file (filename: string) = raise_err (Fatal_UnableToReadFile, U.format1 "Unable to read file %s\n" filename) let read_file (filename:string) = - let debug = FStar_Options.debug_any () in + let debug = FStar_Compiler_Debug.any () in match read_vfs_entry filename with | Some (_mtime, contents) -> if debug then U.print1 "Reading in-memory file %s\n" filename; @@ -268,7 +268,7 @@ let parse fn = current_pos lexbuf in let raw_contents = contents_at d.drange in - if FStar_Options.debug_any() + if FStar_Compiler_Debug.any() then FStar_Compiler_Util.print2 "At range %s, got code\n%s\n" (FStar_Compiler_Range.string_of_range raw_contents.range) diff --git a/ocaml/fstar-lib/FStar_Tactics_Load.ml b/ocaml/fstar-lib/FStar_Tactics_Load.ml index ed563d54aa9..4bee7e0044e 100644 --- a/ocaml/fstar-lib/FStar_Tactics_Load.ml +++ b/ocaml/fstar-lib/FStar_Tactics_Load.ml @@ -6,8 +6,8 @@ module EC = FStar_Errors_Codes module EM = FStar_Errors_Msg module O = FStar_Options -let perr s = if O.debug_any () then U.print_error s -let perr1 s x = if O.debug_any () then U.print1_error s x +let perr s = if FStar_Compiler_Debug.any () then U.print_error s +let perr1 s x = if FStar_Compiler_Debug.any () then U.print1_error s x let dynlink (fname:string) : unit = try diff --git a/ocaml/fstar-lib/FStar_Tactics_Native.ml b/ocaml/fstar-lib/FStar_Tactics_Native.ml index f1e3d8148c6..df1cc6729e1 100644 --- a/ocaml/fstar-lib/FStar_Tactics_Native.ml +++ b/ocaml/fstar-lib/FStar_Tactics_Native.ml @@ -30,8 +30,8 @@ type native_primitive_step = strong_reduction_ok: bool; tactic: itac} -let perr s = if O.debug_any () then BU.print_error s -let perr1 s x = if O.debug_any () then BU.print1_error s x +let perr s = if FStar_Compiler_Debug.any () then BU.print_error s +let perr1 s x = if FStar_Compiler_Debug.any () then BU.print1_error s x let compiled_tactics: native_primitive_step list ref = ref [] diff --git a/src/basic/FStar.Errors.fst b/src/basic/FStar.Errors.fst index 21f10308208..4368fc263fb 100644 --- a/src/basic/FStar.Errors.fst +++ b/src/basic/FStar.Errors.fst @@ -17,6 +17,7 @@ module FStar.Errors open FStar.Pervasives open FStar.String +open FStar.Compiler open FStar.Compiler.Effect open FStar.Compiler.List open FStar.Compiler.Util @@ -253,7 +254,7 @@ let mk_default_handler print = err_count := 1 + !err_count); begin match e.issue_level with | EInfo -> print_issue e - | _ when print && Options.debug_any () -> print_issue e + | _ when print && Debug.any () -> print_issue e | _ -> issues := e :: !issues end; if Options.defensive_abort () && e.issue_number = Some defensive_errno then @@ -352,7 +353,7 @@ let maybe_add_backtrace (msg : error_message) : error_message = msg let diag_doc r msg = - if Options.debug_any() then + if Debug.any() then let msg = maybe_add_backtrace msg in let ctx = get_ctx () in add_one (mk_issue EInfo (Some r) msg None ctx) @@ -361,7 +362,7 @@ let diag r msg = diag_doc r (mkmsg msg) let diag0 msg = - if Options.debug_any() + if Debug.any() then add_one (mk_issue EInfo None (mkmsg msg) None []) let diag1 f a = diag0 (BU.format1 f a) diff --git a/src/basic/FStar.Options.fst b/src/basic/FStar.Options.fst index c95fc04e594..0b93912fa1d 100644 --- a/src/basic/FStar.Options.fst +++ b/src/basic/FStar.Options.fst @@ -153,9 +153,9 @@ let defaults = ("cmi" , Bool false); ("codegen" , Unset); ("codegen-lib" , List []); - ("debug" , List []); - ("debug_level" , List []); ("defensive" , String "no"); + ("debug" , List []); + ("debug_all_modules" , Bool false); ("dep" , Unset); ("detail_errors" , Bool false); ("detail_hint_replay" , Bool false); @@ -347,8 +347,6 @@ let get_print_cache_version () = lookup_opt "print_cache_version" let get_cmi () = lookup_opt "cmi" as_bool let get_codegen () = lookup_opt "codegen" (as_option as_string) let get_codegen_lib () = lookup_opt "codegen-lib" (as_list as_string) -let get_debug () = lookup_opt "debug" as_comma_string_list -let get_debug_level () = lookup_opt "debug_level" as_comma_string_list let get_defensive () = lookup_opt "defensive" as_string let get_dep () = lookup_opt "dep" (as_option as_string) let get_detail_errors () = lookup_opt "detail_errors" as_bool @@ -460,20 +458,6 @@ let get_profile () = lookup_opt "profile" let get_profile_group_by_decl () = lookup_opt "profile_group_by_decl" as_bool let get_profile_component () = lookup_opt "profile_component" (as_option (as_list as_string)) -let dlevel = function - | "Low" -> Low - | "Medium" -> Medium - | "High" -> High - | "Extreme" -> Extreme - | s -> Other s -let one_debug_level_geq l1 l2 = match l1 with - | Other _ - | Low -> l1 = l2 - | Medium -> (l2 = Low || l2 = Medium) - | High -> (l2 = Low || l2 = Medium || l2 = High) - | Extreme -> (l2 = Low || l2 = Medium || l2 = High || l2 = Extreme) -let debug_level_geq l2 = get_debug_level() |> Util.for_some (fun l1 -> one_debug_level_geq (dlevel l1) l2) - // Note: the "ulib/fstar" is for the case where package is installed in the // standard "unix" way (e.g. opam) and the lib directory is $PREFIX/lib/fstar let universe_include_path_base_dirs = @@ -737,15 +721,20 @@ let rec specs_with_types warn_unsafe : list (char * string * opt_type * Pprint.d Accumulated (SimpleStr "namespace"), text "External runtime library (i.e. M.N.x extracts to M.N.X instead of M_N.x)"); - ( noshort, + ( 'd', "debug", - Accumulated (SimpleStr "module_name"), - text "Print lots of debugging information while checking module"); + PostProcessed ( + (fun o -> + let keys = as_comma_string_list o in + Debug.enable_toggles keys; + o), Accumulated (SimpleStr "debug toggles")), + text "Debug toggles (comma-separated list of debug keys)"); ( noshort, - "debug_level", - Accumulated (OpenEnumStr (["Low"; "Medium"; "High"; "Extreme"], "...")), - text "Control the verbosity of debugging info"); + "debug_all_modules", + Const (Bool true), + text "Enable to make the effect of --debug apply to every module processed by the compiler, \ + including dependencies."); ( noshort, "defensive", @@ -1449,7 +1438,7 @@ let settable = function | "compat_pre_typed_indexed_effects" | "disallow_unification_guards" | "debug" - | "debug_level" + | "debug_all_modules" | "defensive" | "detail_errors" | "detail_hint_replay" @@ -1804,11 +1793,6 @@ let codegen () = (fun s -> parse_codegen s |> must) let codegen_libs () = get_codegen_lib () |> List.map (fun x -> Util.split x ".") -let debug_any () = get_debug () <> [] - -let debug_module modul = (get_debug () |> List.existsb (module_name_eq modul)) -let debug_at_level_no_module level = debug_level_geq level -let debug_at_level modul level = debug_module modul && debug_at_level_no_module level let profile_group_by_decls () = get_profile_group_by_decl () let defensive () = get_defensive () <> "no" @@ -1944,6 +1928,9 @@ let use_nbe_for_extraction () = get_use_nbe_for_extraction () let trivial_pre_for_unannotated_effectful_fns () = get_trivial_pre_for_unannotated_effectful_fns () +let debug_keys () = lookup_opt "debug" (as_list as_string) +let debug_all_modules () = lookup_opt "debug_all_modules" as_bool + let with_saved_options f = // take some care to not mess up the stack on errors // (unless we're trying to track down an error) diff --git a/src/basic/FStar.Options.fsti b/src/basic/FStar.Options.fsti index 7605213f317..06a503029c7 100644 --- a/src/basic/FStar.Options.fsti +++ b/src/basic/FStar.Options.fsti @@ -23,13 +23,6 @@ open FStar.Compiler //let __test_norm_all = Util.mk_ref false -type debug_level_t = - | Low - | Medium - | High - | Extreme - | Other of string - type split_queries_t = | No | OnFailure | Always type option_val = @@ -56,7 +49,7 @@ type opt_type = | EnumStr of list string // --codegen OCaml | OpenEnumStr of list string (* suggested values (not exhaustive) *) * string (* label *) - // --debug_level … + // --debug … | PostProcessed of ((option_val -> option_val) (* validator *) * opt_type (* elem spec *)) // For options like --extract_module that require post-processing or validation | Accumulated of opt_type (* elem spec *) @@ -249,19 +242,12 @@ val use_nbe_for_extraction : unit -> bool val trivial_pre_for_unannotated_effectful_fns : unit -> bool -(* True iff the user passed '--debug M' for some M *) -val debug_any : unit -> bool - -(* True for M when the user passed '--debug M' *) -val debug_module : string -> bool - -(* True for M and L when the user passed '--debug M --debug_level L' - * (and possibly more) *) -val debug_at_level : string -> debug_level_t -> bool +(* List of enabled debug toggles. *) +val debug_keys : unit -> list string -(* True for L when the user passed '--debug_level L' - * (and possibly more, but independent of --debug) *) -val debug_at_level_no_module : debug_level_t -> bool +(* Whether we are debugging every module and not just the ones +in the cmdline. *) +val debug_all_modules : unit -> bool // HACK ALERT! This is to ensure we have no dependency from Options to Version, // otherwise, since Version is regenerated all the time, this invalidates the diff --git a/src/extraction/FStar.Extraction.ML.Modul.fst b/src/extraction/FStar.Extraction.ML.Modul.fst index 268f03d4817..16770cf6dc4 100644 --- a/src/extraction/FStar.Extraction.ML.Modul.fst +++ b/src/extraction/FStar.Extraction.ML.Modul.fst @@ -50,6 +50,8 @@ module EMB = FStar.Syntax.Embeddings module Cfg = FStar.TypeChecker.Cfg module PO = FStar.TypeChecker.Primops +let dbg_ExtractionReify = Debug.get_toggle "ExtractionReify" + type tydef_declaration = (mlsymbol * FStar.Extraction.ML.Syntax.metadata * int) //int is the arity type iface = { @@ -554,7 +556,7 @@ let extract_reifiable_effect g ed in let rec extract_fv tm = - if Env.debug (tcenv_of_uenv g) <| Options.Other "ExtractionReify" then + if !dbg_ExtractionReify then BU.print1 "extract_fv term: %s\n" (Print.term_to_string tm); match (SS.compress tm).n with | Tm_uinst (tm, _) -> extract_fv tm @@ -569,7 +571,7 @@ let extract_reifiable_effect g ed let extract_action g (a:S.action) = assert (match a.action_params with | [] -> true | _ -> false); - if Env.debug (tcenv_of_uenv g) <| Options.Other "ExtractionReify" then + if !dbg_ExtractionReify then BU.print2 "Action type %s and term %s\n" (Print.term_to_string a.action_typ) (Print.term_to_string a.action_defn); @@ -585,9 +587,9 @@ let extract_reifiable_effect g ed | None -> failwith "No type scheme") | _ -> failwith "Impossible" in let a_nm, a_lid, exp_b, g = extend_with_action_name g ed a tysc in - if Env.debug (tcenv_of_uenv g) <| Options.Other "ExtractionReify" then + if !dbg_ExtractionReify then BU.print1 "Extracted action term: %s\n" (Code.string_of_mlexpr a_nm a_let); - if Env.debug (tcenv_of_uenv g) <| Options.Other "ExtractionReify" then begin + if !dbg_ExtractionReify then begin BU.print1 "Extracted action type: %s\n" (Code.string_of_mlty a_nm (snd tysc)); List.iter (fun x -> BU.print1 "and binders: %s\n" x) (ty_param_names (fst tysc)) end; let iface, impl = extend_iface a_lid a_nm exp exp_b in @@ -877,7 +879,7 @@ let extract_iface' (g:env_t) modul = let extract_iface (g:env_t) modul = let g, iface = UF.with_uf_enabled (fun () -> - if Options.debug_any() + if Debug.any() then FStar.Compiler.Util.measure_execution_time (BU.format1 "Extracted interface of %s" (string_of_lid modul.name)) (fun () -> extract_iface' g modul) @@ -1290,7 +1292,7 @@ let extract' (g:uenv) (m:modul) : uenv * option mllib = let g, sigs = BU.fold_map (fun g se -> - if Options.debug_module (string_of_lid m.name) + if Debug.any () then let nm = FStar.Syntax.Util.lids_of_sigelt se |> List.map Ident.string_of_lid |> String.concat ", " in BU.print1 "+++About to extract {%s}\n" nm; FStar.Compiler.Util.measure_execution_time diff --git a/src/extraction/FStar.Extraction.ML.RegEmb.fst b/src/extraction/FStar.Extraction.ML.RegEmb.fst index 113465cdef2..ac3bdff1119 100644 --- a/src/extraction/FStar.Extraction.ML.RegEmb.fst +++ b/src/extraction/FStar.Extraction.ML.RegEmb.fst @@ -191,9 +191,11 @@ let builtin_embeddings : list (Ident.lident & embedding_data) = (RC.fstar_refl_data_lid "qualifier", {arity=0; syn_emb=refl_emb_lid "e_qualifier"; nbe_emb=Some(nbe_refl_emb_lid "e_qualifier")}); ] +let dbg_plugin = Debug.get_toggle "Plugins" + let local_fv_embeddings : ref (list (Ident.lident & embedding_data)) = BU.mk_ref [] let register_embedding (l: Ident.lident) (d: embedding_data) : unit = - if Options.debug_at_level_no_module (Options.Other "Plugins") then + if !dbg_plugin then BU.print1 "Registering local embedding for %s\n" (Ident.string_of_lid l); local_fv_embeddings := (l,d) :: !local_fv_embeddings diff --git a/src/extraction/FStar.Extraction.ML.Term.fst b/src/extraction/FStar.Extraction.ML.Term.fst index 224d91a7237..8a5c0699307 100644 --- a/src/extraction/FStar.Extraction.ML.Term.fst +++ b/src/extraction/FStar.Extraction.ML.Term.fst @@ -48,6 +48,9 @@ module TcTerm = FStar.TypeChecker.TcTerm module TcUtil = FStar.TypeChecker.Util module U = FStar.Syntax.Util +let dbg_Extraction = Debug.get_toggle "Extraction" +let dbg_ExtractionNorm = Debug.get_toggle "ExtractionNorm" + exception Un_extractable @@ -1894,7 +1897,7 @@ and term_as_mlexpr' (g:uenv) (top:term) : (mlexpr * e_tag * mlty) = // (Ident.lid_of_path ((fst (current_module_of_uenv g)) @ [snd (current_module_of_uenv g)]) Range.dummyRange) in // debug g (fun () -> // BU.print1 "!!!!!!!About to normalize: %s\n" (Print.term_to_string lb.lbdef); - // Options.set_option "debug_level" (Options.List [Options.String "Norm"; Options.String "Extraction"])); + // Options.set_option "debug" (Options.List [Options.String "Norm"; Options.String "Extraction"])); let lbdef = let norm_call () = Profiling.profile @@ -1903,8 +1906,7 @@ and term_as_mlexpr' (g:uenv) (top:term) : (mlexpr * e_tag * mlty) = (Some (Ident.string_of_lid (Env.current_module tcenv))) "FStar.Extraction.ML.Term.normalize_lb_def" in - if TcEnv.debug tcenv <| Options.Other "Extraction" - || TcEnv.debug tcenv <| Options.Other "ExtractNorm" + if !dbg_Extraction || !dbg_ExtractionNorm then let _ = BU.print2 "Starting to normalize top-level let %s = %s\n" (Print.lbname_to_string lb.lbname) (Print.term_to_string lb.lbdef) diff --git a/src/extraction/FStar.Extraction.ML.UEnv.fst b/src/extraction/FStar.Extraction.ML.UEnv.fst index 5df27365f1f..91a01472176 100644 --- a/src/extraction/FStar.Extraction.ML.UEnv.fst +++ b/src/extraction/FStar.Extraction.ML.UEnv.fst @@ -118,9 +118,10 @@ let with_typars_env (u:uenv) (f:_) = // Only for debug printing in Modul.fs let bindings_of_uenv u = u.env_bindings +let dbg = Debug.get_toggle "Extraction" let debug g f = let c = string_of_mlpath g.currentModule in - if Options.debug_at_level c (Options.Other "Extraction") + if !dbg then f () let print_mlpath_map (g:uenv) = diff --git a/src/fstar/FStar.CheckedFiles.fst b/src/fstar/FStar.CheckedFiles.fst index f629b8e123d..1e35e25a626 100644 --- a/src/fstar/FStar.CheckedFiles.fst +++ b/src/fstar/FStar.CheckedFiles.fst @@ -29,6 +29,8 @@ module SMT = FStar.SMTEncoding.Solver module BU = FStar.Compiler.Util module Dep = FStar.Parser.Dep +let dbg = Debug.get_toggle "CheckedFiles" + (* * We write this version number to the cache files, and * detect when loading the cache that the version number is same @@ -152,7 +154,7 @@ let hash_dependences (deps:Dep.deps) (fn:string) :either string (list (string * "hash_dependences::the interface checked file %s does not exist\n" iface in - if Options.debug_at_level_no_module (Options.Other "CheckedFiles") + if !dbg then BU.print1 "%s\n" msg; Inl msg @@ -176,7 +178,7 @@ let hash_dependences (deps:Dep.deps) (fn:string) :either string (list (string * match BU.smap_try_find mcache cache_fn with | None -> let msg = BU.format2 "For dependency %s, cache file %s is not loaded" fn cache_fn in - if Options.debug_at_level_no_module (Options.Other "CheckedFiles") + if !dbg then BU.print1 "%s\n" msg; Inl msg | Some (Invalid msg, _) -> Inl msg @@ -201,7 +203,7 @@ let hash_dependences (deps:Dep.deps) (fn:string) :either string (list (string * * See above for the two steps of loading the checked files *) let load_checked_file (fn:string) (checked_fn:string) :cache_t = - if Options.debug_at_level_no_module (Options.Other "CheckedFiles") then + if !dbg then BU.print1 "Trying to load checked file result %s\n" checked_fn; let elt = checked_fn |> BU.smap_try_find mcache in if elt |> is_some then elt |> must //already loaded @@ -222,7 +224,7 @@ let load_checked_file (fn:string) (checked_fn:string) :cache_t = else let current_digest = BU.digest_of_file fn in if x.digest <> current_digest then begin - if Options.debug_at_level_no_module (Options.Other "CheckedFiles") then + if !dbg then BU.print4 "Checked file %s is stale since incorrect digest of %s, \ expected: %s, found: %s\n" checked_fn fn current_digest x.digest; @@ -238,7 +240,7 @@ let load_checked_file (fn:string) (checked_fn:string) :cache_t = *) let load_checked_file_with_tc_result (deps:Dep.deps) (fn:string) (checked_fn:string) :either string tc_result = - if Options.debug_at_level_no_module (Options.Other "CheckedFiles") then + if !dbg then BU.print1 "Trying to load checked file with tc result %s\n" checked_fn; let load_tc_result (fn:string) :list (string * string) * tc_result = @@ -307,7 +309,7 @@ let load_checked_file_with_tc_result (deps:Dep.deps) (fn:string) (checked_fn:str Inr tc_result end else begin - if Options.debug_at_level_no_module (Options.Other "CheckedFiles") + if !dbg then begin BU.print4 "Expected (%s) hashes:\n%s\n\nGot (%s) hashes:\n\t%s\n" (BU.string_of_int (List.length deps_dig')) @@ -402,7 +404,7 @@ let load_module_from_cache = cache_file with | Inl msg -> fail msg cache_file; None | Inr tc_result -> - if Options.debug_at_level_no_module (Options.Other "CheckedFiles") then + if !dbg then BU.print1 "Successfully loaded module from checked file %s\n" cache_file; Some tc_result (* | _ -> failwith "load_checked_file_tc_result must have an Invalid or Valid entry" *) diff --git a/src/fstar/FStar.Interactive.Ide.fst b/src/fstar/FStar.Interactive.Ide.fst index 92a13931631..6fbb616d1da 100644 --- a/src/fstar/FStar.Interactive.Ide.fst +++ b/src/fstar/FStar.Interactive.Ide.fst @@ -31,6 +31,8 @@ open FStar.Interactive.PushHelper open FStar.Interactive.Ide.Types module BU = FStar.Compiler.Util +let dbg = Debug.get_toggle "IDE" + open FStar.Universal open FStar.TypeChecker.Env open FStar.TypeChecker.Common @@ -138,7 +140,7 @@ This function is stateful: it uses ``push_repl`` and ``pop_repl``. let run_repl_ld_transactions (st: repl_state) (tasks: list repl_task) (progress_callback: repl_task -> unit) = let debug verb task = - if Options.debug_at_level_no_module (Options.Other "IDE") then + if !dbg then Util.print2 "%s %s" verb (string_of_repl_task task) in (* Run as many ``pop_repl`` as there are entries in the input stack. @@ -744,7 +746,7 @@ let run_push_without_deps st query ((status, json_errors), Inl st) let run_push_with_deps st query = - if Options.debug_at_level_no_module (Options.Other "IDE") then + if !dbg then Util.print_string "Reloading dependencies"; TcEnv.toggle_id_info st.repl_env false; match load_deps st with @@ -1074,7 +1076,7 @@ let run_query_result = (query_status * list json) * either repl_state int let maybe_cancel_queries st l = let log_cancellation l = - if Options.debug_at_level_no_module (Options.Other "IDE") + if !dbg then List.iter (fun q -> BU.print1 "Cancelling query: %s\n" (query_to_string q)) l in match st.repl_buffered_input_queries with @@ -1172,7 +1174,7 @@ let rec run_query st (q: query) : (query_status * list json) * either repl_state and validate_and_run_query st query = let query = validate_query st query in repl_current_qid := Some query.qid; - if Options.debug_at_level_no_module (Options.Other "IDE") + if !dbg then BU.print2 "Running query %s: %s\n" query.qid (query_to_string query); run_query st query diff --git a/src/fstar/FStar.Interactive.Incremental.fst b/src/fstar/FStar.Interactive.Incremental.fst index 77a6fa37db0..cc576289d4f 100644 --- a/src/fstar/FStar.Interactive.Incremental.fst +++ b/src/fstar/FStar.Interactive.Incremental.fst @@ -313,7 +313,7 @@ let run_full_buffer (st:repl_state) run_qst (inspect_repl_stack (!repl_stack) decls push_kind with_symbols write_full_buffer_fragment_progress) qid in if request_type <> Cache then log_syntax_issues err_opt; - if Options.debug_any() + if Debug.any() then ( BU.print1 "Generating queries\n%s\n" (String.concat "\n" (List.map query_to_string queries)) diff --git a/src/fstar/FStar.Interactive.Legacy.fst b/src/fstar/FStar.Interactive.Legacy.fst index 6ca6a742da6..7268e17aa7a 100644 --- a/src/fstar/FStar.Interactive.Legacy.fst +++ b/src/fstar/FStar.Interactive.Legacy.fst @@ -127,7 +127,7 @@ let the_interactive_state = { let rec read_chunk () = let s = the_interactive_state in let log : string -> unit = - if Options.debug_any() then + if Debug.any() then let transcript = match !s.log with | Some transcript -> transcript diff --git a/src/fstar/FStar.Main.fst b/src/fstar/FStar.Main.fst index c06f5c14405..e13497bfcdd 100644 --- a/src/fstar/FStar.Main.fst +++ b/src/fstar/FStar.Main.fst @@ -98,7 +98,7 @@ let load_native_tactics () = end in let cmxs_files = (modules_to_load@cmxs_to_load) |> List.map cmxs_file in - if Options.debug_any () then + if Debug.any () then Util.print1 "Will try to load cmxs files: [%s]\n" (String.concat ", " cmxs_files); Tactics.Load.load_tactics cmxs_files; iter_opt (Options.use_native_tactics ()) Tactics.Load.load_tactics_dir; diff --git a/src/fstar/FStar.Universal.fst b/src/fstar/FStar.Universal.fst index 48820fb1e12..d142b49d7ab 100644 --- a/src/fstar/FStar.Universal.fst +++ b/src/fstar/FStar.Universal.fst @@ -553,8 +553,9 @@ let rec tc_fold_interleave (deps:FStar.Parser.Dep.deps) //used to query parsing (***********************************************************************) (* Batch mode: checking many files *) (***********************************************************************) +let dbg_dep = Debug.get_toggle "Dep" let batch_mode_tc filenames dep_graph = - if Options.debug_at_level_no_module (Options.Other "Dep") then begin + if !dbg_dep then begin FStar.Compiler.Util.print_endline "Auto-deps kicked in; here's some info."; FStar.Compiler.Util.print1 "Here's the list of filenames we will process: %s\n" (String.concat " " filenames); diff --git a/src/parser/FStar.Parser.Dep.fst b/src/parser/FStar.Parser.Dep.fst index c8295be9966..8e1b65292f0 100644 --- a/src/parser/FStar.Parser.Dep.fst +++ b/src/parser/FStar.Parser.Dep.fst @@ -39,6 +39,8 @@ open FStar.Class.Show module Const = FStar.Parser.Const module BU = FStar.Compiler.Util +let dbg = Debug.get_toggle "Dep" + let profile f c = Profiling.profile f None c (* Meant to write to a file as an out_channel. If an exception is raised, @@ -720,7 +722,7 @@ let collect_one let add_dep_on_module (module_name : lid) (is_friend : bool) = if add_dependence_edge working_map module_name is_friend then () - else if Options.debug_at_level_no_module (Options.Other "Dep") then + else if !dbg then FStar.Errors.log_issue (range_of_lid module_name) (Errors.Warning_UnboundModuleReference, (BU.format1 "Unbound module reference %s" (Ident.string_of_lid module_name))) @@ -770,7 +772,7 @@ let collect_one if data_from_cache |> is_some then begin //we found the parsing data in the checked file let deps, has_inline_for_extraction, mo_roots = from_parsing_data (data_from_cache |> must) original_map filename in - if Options.debug_at_level_no_module (Options.Other "Dep") then + if !dbg then BU.print2 "Reading the parsing data for %s from its checked file .. found [%s]\n" filename (show deps); data_from_cache |> must, deps, has_inline_for_extraction, mo_roots @@ -1242,7 +1244,7 @@ let topological_dependences_of' * dependencies. Otherwise, the map only contains its direct dependencies. *) all_friends, all_files | White -> - if Options.debug_at_level_no_module (Options.Other "Dep") + if !dbg then BU.print2 "Visiting %s: direct deps are %s\n" filename (show dep_node.edges); (* Unvisited. Compute. *) @@ -1257,7 +1259,7 @@ let topological_dependences_of' in (* Mutate the graph to mark the node as visited *) deps_add_dep dep_graph filename ({dep_node with color=Black}); - if Options.debug_at_level_no_module (Options.Other "Dep") + if !dbg then BU.print1 "Adding %s\n" filename; (* Also build the topological sort (Tarjan's algorithm). *) List.collect @@ -1339,7 +1341,7 @@ let topological_dependences_of' let friends, all_files_0 = all_friend_deps dep_graph [] ([], []) root_files in - if Options.debug_at_level_no_module (Options.Other "Dep") + if !dbg then BU.print3 "Phase1 complete:\n\t\ all_files = %s\n\t\ all_friends=%s\n\t\ @@ -1351,11 +1353,11 @@ let topological_dependences_of' widen_deps friends dep_graph file_system_map widened in let _, all_files = - if Options.debug_at_level_no_module (Options.Other "Dep") + if !dbg then BU.print_string "==============Phase2==================\n"; all_friend_deps dep_graph [] ([], []) root_files in - if Options.debug_at_level_no_module (Options.Other "Dep") + if !dbg then BU.print1 "Phase2 complete: all_files = %s\n" (String.concat ", " all_files); all_files, widened @@ -1366,7 +1368,7 @@ let phase1 interfaces_needing_inlining for_extraction = - if Options.debug_at_level_no_module (Options.Other "Dep") + if !dbg then BU.print_string "==============Phase1==================\n"; let widened = false in if Options.cmi() @@ -1588,7 +1590,7 @@ let collect (all_cmd_line_files: list file_name) (Options.codegen()<>None)) "FStar.Parser.Dep.topological_dependences_of" in - if Options.debug_at_level_no_module (Options.Other "Dep") + if !dbg then BU.print1 "Interfaces needing inlining: %s\n" (String.concat ", " inlining_ifaces); all_files, mk_deps dep_graph file_system_map all_cmd_line_files all_files inlining_ifaces parse_results diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index 231e2de59b4..9d65ca8a5a5 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -43,6 +43,10 @@ module TcUtil = FStar.TypeChecker.Util module UF = FStar.Syntax.Unionfind module U = FStar.Syntax.Util +let dbg_SMTEncoding = Debug.get_toggle "SMTEncoding" +let dbg_SMTQuery = Debug.get_toggle "SMTQuery" +let dbg_Time = Debug.get_toggle "Time" + let norm_before_encoding env t = let steps = [Env.Eager_unfolding; Env.Simplify; @@ -565,7 +569,7 @@ let encode_top_level_val uninterpreted env fv t quals = env.tcenv t else norm_before_encoding env t in - // if Env.debug env.tcenv <| Options.Other "SMTEncoding" + // if !dbg_SMTEncoding // then BU.print3 "Encoding top-level val %s : %s\Normalized to is %s\n" // (Print.fv_to_string fv) // (Print.term_to_string t) @@ -753,7 +757,7 @@ let encode_top_level_let : (* Open binders *) let (binders, body, t_body_comp) = destruct_bound_function t_norm e in let t_body = U.comp_result t_body_comp in - if Env.debug env.tcenv <| Options.Other "SMTEncoding" + if !dbg_SMTEncoding then BU.print2 "Encoding let : binders=[%s], body=%s\n" (Print.binders_to_string ", " binders) (Print.term_to_string body); @@ -848,7 +852,7 @@ let encode_top_level_let : | _ -> failwith "Impossible" in {env with tcenv=tcenv'}, e, t_norm in - if Env.debug env0.tcenv <| Options.Other "SMTEncoding" + if !dbg_SMTEncoding then BU.print3 "Encoding let rec %s : %s = %s\n" (Print.lbname_to_string lbn) (Print.term_to_string t_norm) @@ -858,7 +862,7 @@ let encode_top_level_let : let (binders, body, tres_comp) = destruct_bound_function t_norm e in let curry = fvb.smt_arity <> List.length binders in let pre_opt, tres = TcUtil.pure_or_ghost_pre_and_post env.tcenv tres_comp in - if Env.debug env0.tcenv <| Options.Other "SMTEncoding" + if !dbg_SMTEncoding then BU.print4 "Encoding let rec %s: \n\tbinders=[%s], \n\tbody=%s, \n\ttres=%s\n" (Print.lbname_to_string lbn) (Print.binders_to_string ", " binders) @@ -1010,7 +1014,7 @@ let rec encode_sigelt (env:env_t) (se:sigelt) : (decls_t * env_t) = match g with | [] -> begin - if Env.debug env.tcenv <| Options.Other "SMTEncoding" then + if !dbg_SMTEncoding then BU.print1 "Skipped encoding of %s\n" nm; [Caption (BU.format1 "" nm)] |> mk_decls_trivial end @@ -1021,7 +1025,7 @@ let rec encode_sigelt (env:env_t) (se:sigelt) : (decls_t * env_t) = g, env and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = - if Env.debug env.tcenv <| Options.Other "SMTEncoding" + if !dbg_SMTEncoding then (BU.print1 "@@@Encoding sigelt %s\n" (Print.sigelt_to_string se)); let is_opaque_to_smt (t:S.term) = @@ -1174,7 +1178,7 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = (* Discriminators *) | Sig_let _ when (se.sigquals |> BU.for_some (function Discriminator _ -> true | _ -> false)) -> //Discriminators are encoded directly via (our encoding of) theory of datatypes - if Env.debug env.tcenv <| Options.Other "SMTEncoding" then + if !dbg_SMTEncoding then BU.print1 "Not encoding discriminator '%s'\n" (Print.sigelt_to_string_short se); [], env @@ -1182,7 +1186,7 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = | Sig_let {lids} when (lids |> BU.for_some (fun (l:lident) -> string_of_id (List.hd (ns_of_lid l)) = "Prims") && se.sigquals |> BU.for_some (function Unfold_for_unification_and_vcgen -> true | _ -> false)) -> //inline lets from prims are never encoded as definitions --- since they will be inlined - if Env.debug env.tcenv <| Options.Other "SMTEncoding" then + if !dbg_SMTEncoding then BU.print1 "Not encoding unfold let from Prims '%s'\n" (Print.sigelt_to_string_short se); [], env @@ -1288,7 +1292,7 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = in List.forall2 tp_ok tps us in - if Env.debug env.tcenv <| Options.Other "SMTEncoding" + if !dbg_SMTEncoding then BU.print2 "%s injectivity for %s\n" (if is_injective then "YES" else "NO") (Ident.string_of_lid t); @@ -1754,7 +1758,7 @@ let encode_env_bindings (env:env_t) (bindings:list S.binding) : (decls_t * env_t | S.Binding_var x -> let t1 = norm_before_encoding env x.sort in - if Env.debug env.tcenv <| Options.Other "SMTEncoding" + if !dbg_SMTEncoding then (BU.print3 "Normalized %s : %s to %s\n" (Print.bv_to_string x) (Print.term_to_string x.sort) (Print.term_to_string t1)); let t, decls' = encode_term t1 env in let t_hash = Term.hash_of_term t in @@ -1886,7 +1890,7 @@ let encode_sig tcenv se = if Options.log_queries() then Term.Caption ("encoding sigelt " ^ Print.sigelt_to_string_short se)::decls else decls in - if Env.debug tcenv Options.Medium + if Debug.medium () then BU.print1 "+++++++++++Encoding sigelt %s\n" (Print.sigelt_to_string se); let env = get_env (Env.current_module tcenv) tcenv in let decls, env = encode_top_level_facts env se in @@ -1911,7 +1915,7 @@ let encode_modul tcenv modul = UF.with_uf_enabled (fun () -> varops.reset_fresh (); let name = BU.format2 "%s %s" (if modul.is_interface then "interface" else "module") (string_of_lid modul.name) in - if Env.debug tcenv Options.Medium + if Debug.medium () then BU.print2 "+++++++++++Encoding externals for %s ... %s declarations\n" name (List.length modul.declarations |> string_of_int); let env = get_env modul.name tcenv |> reset_current_module_fvbs in let encode_signature (env:env_t) (ses:sigelts) = @@ -1921,7 +1925,7 @@ let encode_modul tcenv modul = in let decls, env = encode_signature ({env with warn=false}) modul.declarations in give_decls_to_z3_and_set_env env name decls; - if Env.debug tcenv Options.Medium then BU.print1 "Done encoding externals for %s\n" name; + if Debug.medium () then BU.print1 "Done encoding externals for %s\n" name; decls, env |> get_current_module_fvbs ) end @@ -1930,7 +1934,7 @@ let encode_modul_from_cache tcenv tcmod (decls, fvbs) = else let tcenv = Env.set_current_module tcenv tcmod.name in let name = BU.format2 "%s %s" (if tcmod.is_interface then "interface" else "module") (string_of_lid tcmod.name) in - if Env.debug tcenv Options.Medium + if Debug.medium () then BU.print2 "+++++++++++Encoding externals from cache for %s ... %s decls\n" name (List.length decls |> string_of_int); let env = get_env tcmod.name tcenv |> reset_current_module_fvbs in let env = @@ -1938,7 +1942,7 @@ let encode_modul_from_cache tcenv tcmod (decls, fvbs) = add_fvar_binding_to_env fvb env ) env in give_decls_to_z3_and_set_env env name decls; - if Env.debug tcenv Options.Medium then BU.print1 "Done encoding externals from cache for %s\n" name + if Debug.medium () then BU.print1 "Done encoding externals from cache for %s\n" name open FStar.SMTEncoding.Z3 let encode_query use_env_msg (tcenv:Env.env) (q:S.term) @@ -1969,9 +1973,7 @@ let encode_query use_env_msg (tcenv:Env.env) (q:S.term) U.close_forall_no_univs (List.rev closing) q, bindings in let env_decls, env = encode_env_bindings env bindings in - if debug tcenv Options.Medium - || debug tcenv <| Options.Other "SMTEncoding" - || debug tcenv <| Options.Other "SMTQuery" + if Debug.medium () || !dbg_SMTEncoding || !dbg_SMTQuery then BU.print1 "Encoding query formula {: %s\n" (Print.term_to_string q); let (phi, qdecls), ms = BU.record_time (fun () -> encode_formula q env) in let labels, phi = ErrorReporting.label_goals use_env_msg (Env.get_range tcenv) phi in @@ -1992,14 +1994,9 @@ let encode_query use_env_msg (tcenv:Env.env) (q:S.term) let qry = Util.mkAssume(mkNot phi, Some "query", (varops.mk_unique "@query")) in let suffix = [Term.Echo ""] @ label_suffix @ [Term.Echo ""; Term.Echo "Done!"] in - if debug tcenv Options.Medium - || debug tcenv <| Options.Other "SMTEncoding" - || debug tcenv <| Options.Other "SMTQuery" + if Debug.medium () || !dbg_SMTEncoding || !dbg_SMTQuery then BU.print_string "} Done encoding\n"; - if debug tcenv Options.Medium - || debug tcenv <| Options.Other "SMTEncoding" - || debug tcenv <| Options.Other "SMTQuery" - || debug tcenv <| Options.Other "Time" + if Debug.medium () || !dbg_SMTEncoding || !dbg_Time then BU.print1 "Encoding took %sms\n" (string_of_int ms); query_prelude, labels, qry, suffix ) diff --git a/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst b/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst index 9c7a1ed5435..9a2895231ee 100644 --- a/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst +++ b/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst @@ -50,6 +50,10 @@ module U = FStar.Syntax.Util open FStar.Class.Show open FStar.Class.Setlike +let dbg_PartialApp = Debug.get_toggle "PartialApp" +let dbg_SMTEncoding = Debug.get_toggle "SMTEncoding" +let dbg_SMTEncodingReify = Debug.get_toggle "SMTEncodingReify" + (*---------------------------------------------------------------------------------*) (* *) @@ -374,7 +378,7 @@ and encode_binders (fuel_opt:option term) (bs:Syntax.binders) (env:env_t) : * decls_t (* top-level decls to be emitted *) * list bv) (* names *) = - if Env.debug env.tcenv Options.Medium then BU.print1 "Encoding binders %s\n" (Print.binders_to_string ", " bs); + if Debug.medium () then BU.print1 "Encoding binders %s\n" (Print.binders_to_string ", " bs); let vars, guards, env, decls, names = bs |> List.fold_left @@ -621,7 +625,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t def_check_scoped t.pos "encode_term" env.tcenv t; let t = SS.compress t in let t0 = t in - if Env.debug env.tcenv <| Options.Other "SMTEncoding" + if !dbg_SMTEncoding then BU.print2 "(%s) %s\n" (Print.tag_of_term t) (Print.term_to_string t); match t.n with | Tm_delayed _ @@ -633,7 +637,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t | Tm_lazy i -> let e = U.unfold_lazy i in - if Env.debug env.tcenv <| Options.Other "SMTEncoding" then + if !dbg_SMTEncoding then BU.print2 ">> Unfolded (%s) ~> (%s)\n" (Print.term_to_string t) (Print.term_to_string e); encode_term e env @@ -653,7 +657,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t // // Actual encoding: `q ~> pack qv where qv is the view of q let tv = EMB.embed (R.inspect_ln qt) t.pos None EMB.id_norm_cb in - if Env.debug env.tcenv <| Options.Other "SMTEncoding" then + if !dbg_SMTEncoding then BU.print2 ">> Inspected (%s) ~> (%s)\n" (Print.term_to_string t0) (Print.term_to_string tv); let t = U.mk_app (RC.refl_constant_term RC.fstar_refl_pack_ln) [S.as_arg tv] in @@ -931,7 +935,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t let tkey = mkForall t0.pos ([], ffv::xfv::cvars, encoding) in let tkey_hash = Term.hash_of_term tkey in - if Env.debug env.tcenv (Options.Other "SMTEncoding") + if !dbg_SMTEncoding then BU.print3 "Encoding Tm_refine %s with tkey_hash %s and digest %s\n" (Syntax.Print.term_to_string f) tkey_hash (BU.digest_of_string tkey_hash) else (); @@ -1046,7 +1050,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t | _ -> let e0 = TcUtil.norm_reify env.tcenv [] (U.mk_reify (args_e |> List.hd |> fst) lopt) in - if Env.debug env.tcenv <| Options.Other "SMTEncodingReify" + if !dbg_SMTEncodingReify then BU.print1 "Result of normalization %s\n" (Print.term_to_string e0); let e = S.mk_Tm_app (TcUtil.remove_reify e0) (List.tl args_e) t0.pos in encode_term e env) @@ -1073,7 +1077,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t match ht_opt with | _ when 1=1 -> app_tm, decls@decls' //NS: Intentionally using a default case here to disable the axiom below | Some (head_type, formals, c) -> - if Env.debug env.tcenv (Options.Other "PartialApp") + if !dbg_PartialApp then BU.print5 "Encoding partial application:\n\thead=%s\n\thead_type=%s\n\tformals=%s\n\tcomp=%s\n\tactual args=%s\n" (Print.term_to_string head) (Print.term_to_string head_type) @@ -1083,7 +1087,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t let formals, rest = BU.first_N (List.length args_e) formals in let subst = List.map2 (fun ({binder_bv=bv}) (a, _) -> Syntax.NT(bv, a)) formals args_e in let ty = U.arrow rest c |> SS.subst subst in - if Env.debug env.tcenv (Options.Other "PartialApp") + if !dbg_PartialApp then BU.print1 "Encoding partial application, after subst:\n\tty=%s\n" (Print.term_to_string ty); let vars, pattern, has_type, decls'' = @@ -1091,7 +1095,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t List.fold_left2 (fun (t_hyps, decls) ({binder_bv=bv}) e -> let t = SS.subst subst bv.sort in let t_hyp, decls' = encode_term_pred None t env e in - if Env.debug env.tcenv (Options.Other "PartialApp") + if !dbg_PartialApp then BU.print2 "Encoded typing hypothesis for %s ... got %s\n" (Print.term_to_string t) (Term.print_smt_term t_hyp); @@ -1133,7 +1137,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t has_type, decls@decls'@decls'' in - if Env.debug env.tcenv (Options.Other "PartialApp") + if !dbg_PartialApp then BU.print1 "Encoding partial application, after SMT encoded predicate:\n\t=%s\n" (Term.print_smt_term has_type); let tkey_hash = Term.hash_of_term app_tm in @@ -1182,7 +1186,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t head_type, formals, c else head_type, formals, c in - if Env.debug env.tcenv (Options.Other "PartialApp") + if !dbg_PartialApp then BU.print3 "Encoding partial application, head_type = %s, formals = %s, args = %s\n" (Print.term_to_string head_type) (Print.binders_to_string ", " formals) @@ -1298,7 +1302,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t in let tkey = mkForall t0.pos ([], cvars, key_body) in let tkey_hash = Term.hash_of_term tkey in - if Env.debug env.tcenv <| Options.Other "PartialApp" + if !dbg_PartialApp then BU.print2 "Checking eta expansion of\n\tvars={%s}\n\tbody=%s\n" (List.map fv_name vars |> String.concat ", ") (print_smt_term body); @@ -1392,7 +1396,7 @@ and encode_match (e:S.term) (pats:list S.branch) (default_case:term) (env:env_t) mkLet' ([mk_fv (scrsym,Term_sort), scr], match_tm) Range.dummyRange, decls and encode_pat (env:env_t) (pat:S.pat) : (env_t * pattern) = - if Env.debug env.tcenv Options.Medium then BU.print1 "Encoding pattern %s\n" (Print.pat_to_string pat); + if Debug.medium () then BU.print1 "Encoding pattern %s\n" (Print.pat_to_string pat); let vars, pat_term = FStar.TypeChecker.Util.decorated_pattern_as_term pat in let env, vars = vars |> List.fold_left (fun (env, vars) v -> @@ -1490,7 +1494,7 @@ and encode_smt_patterns (pats_l:list (list S.arg)) env : list (list term) * decl and encode_formula (phi:typ) (env:env_t) : (term * decls_t) = (* expects phi to be normalized; the existential variables are all labels *) let debug phi = - if Env.debug env.tcenv <| Options.Other "SMTEncoding" + if !dbg_SMTEncoding then BU.print2 "Formula (%s) %s\n" (Print.tag_of_term phi) (Print.term_to_string phi) in diff --git a/src/smtencoding/FStar.SMTEncoding.Env.fst b/src/smtencoding/FStar.SMTEncoding.Env.fst index efa5d086317..e17bcac26b7 100644 --- a/src/smtencoding/FStar.SMTEncoding.Env.fst +++ b/src/smtencoding/FStar.SMTEncoding.Env.fst @@ -31,6 +31,8 @@ module SS = FStar.Syntax.Subst module BU = FStar.Compiler.Util module U = FStar.Syntax.Util +let dbg_PartialApp = Debug.get_toggle "PartialApp" + exception Inner_let_rec of list (string * Range.range) //name of the inner let-rec(s) and their locations let add_fuel x tl = if (Options.unthrottle_inductives()) then tl else x::tl @@ -305,7 +307,7 @@ let try_lookup_free_var env l = match lookup_fvar_binding env l with | None -> None | Some fvb -> - if TcEnv.debug env.tcenv <| Options.Other "PartialApp" + if !dbg_PartialApp then BU.print2 "Looked up %s found\n%s\n" (Ident.string_of_lid l) (fvb_to_string fvb); diff --git a/src/smtencoding/FStar.SMTEncoding.Solver.fst b/src/smtencoding/FStar.SMTEncoding.Solver.fst index 4b675a01082..c51e7b97a16 100644 --- a/src/smtencoding/FStar.SMTEncoding.Solver.fst +++ b/src/smtencoding/FStar.SMTEncoding.Solver.fst @@ -971,7 +971,7 @@ let ask_solver_quake then (nsucc, nfail, rs) else begin if quaking_or_retrying - && (Options.interactive () || Options.debug_any ()) (* only on emacs or when debugging *) + && (Options.interactive () || Debug.any ()) (* only on emacs or when debugging *) && n>0 then (* no need to print last *) BU.print5 "%s: so far query %s %sfailed %s (%s runs remain)\n" (if quaking then "Quake" else "Retry") @@ -1298,7 +1298,7 @@ let encode_and_ask (can_split:bool) (is_retry:bool) use_env_msg tcenv q : (list | Assume _ -> if (is_retry || Options.split_queries() = Options.Always) - && Options.debug_any() + && Debug.any() then ( let n = List.length labels in if n <> 1 diff --git a/src/smtencoding/FStar.SMTEncoding.Z3.fst b/src/smtencoding/FStar.SMTEncoding.Z3.fst index 54b0f101f37..5af9d24f80f 100644 --- a/src/smtencoding/FStar.SMTEncoding.Z3.fst +++ b/src/smtencoding/FStar.SMTEncoding.Z3.fst @@ -75,7 +75,7 @@ let z3_exe : unit -> string = else if inpath z3_v then z3_v else Platform.exe "z3" in - if Options.debug_any () then + if Debug.any () then BU.print1 "Chosen Z3 executable: %s\n" path; path ) @@ -448,7 +448,7 @@ let doZ3Exe (log_file:_) (r:Range.range) (fresh:bool) (input:string) (label_mess res else ru) in let status = - if Options.debug_any() then print_string <| format1 "Z3 says: %s\n" (String.concat "\n" smt_output.smt_result); + if Debug.any() then print_string <| format1 "Z3 says: %s\n" (String.concat "\n" smt_output.smt_result); match smt_output.smt_result with | ["unsat"] -> UNSAT unsat_core | ["sat"] -> SAT (labels, reason_unknown) diff --git a/src/syntax/FStar.Syntax.Compress.fst b/src/syntax/FStar.Syntax.Compress.fst index 73fa4be6d4a..5e634c8aed6 100644 --- a/src/syntax/FStar.Syntax.Compress.fst +++ b/src/syntax/FStar.Syntax.Compress.fst @@ -25,7 +25,7 @@ let compress1_t (allow_uvars: bool) (allow_names: bool) : term -> term = | Tm_name bv when not allow_names -> (* This currently happens, and often, but it should not! *) - if Options.debug_any () then + if Debug.any () then Errors.log_issue t.pos (Err.Warning_NameEscape, format1 "Tm_name %s in deep compress" (show bv)); mk (Tm_name ({bv with sort = mk Tm_unknown})) @@ -39,7 +39,7 @@ let compress1_u (allow_uvars:bool) (allow_names:bool) : universe -> universe = fun u -> match u with | U_name bv when not allow_names -> - if Options.debug_any () then + if Debug.any () then Errors.log_issue Range.dummyRange (Err.Warning_NameEscape, format1 "U_name %s in deep compress" (show bv)); u diff --git a/src/syntax/FStar.Syntax.Hash.fst b/src/syntax/FStar.Syntax.Hash.fst index c263d81793f..b6e70f29a5b 100644 --- a/src/syntax/FStar.Syntax.Hash.fst +++ b/src/syntax/FStar.Syntax.Hash.fst @@ -99,7 +99,7 @@ and hash_comp c and hash_term' (t:term) : mm H.hash_code - = // if Options.debug_any () + = // if Debug.any () // then FStar.Compiler.Util.print1 "Hash_term %s\n" (FStar.Syntax.Print.term_to_string t); match (SS.compress t).n with | Tm_bvar bv -> mix (of_int 3) (of_int bv.index) diff --git a/src/tactics/FStar.Tactics.Hooks.fst b/src/tactics/FStar.Tactics.Hooks.fst index b10dbe06ab5..dbf17d331b3 100644 --- a/src/tactics/FStar.Tactics.Hooks.fst +++ b/src/tactics/FStar.Tactics.Hooks.fst @@ -49,6 +49,9 @@ module TcTerm = FStar.TypeChecker.TcTerm hence there is no v1/v2 distinction. *) module RE = FStar.Reflection.V2.Embeddings +let dbg_Tac = Debug.get_toggle "Tac" +let dbg_SpinoffAll = Debug.get_toggle "SpinoffAll" + let run_tactic_on_typ (rng_tac : Range.range) (rng_goal : Range.range) (tactic:term) (env:Env.env) (typ:term) @@ -300,8 +303,7 @@ let preprocess (env:Env.env) (goal:term) (* bool=true iff any tactic actually ran *) = Errors.with_ctx "While preprocessing VC with a tactic" (fun () -> - tacdbg := Env.debug env (O.Other "Tac"); - if !tacdbg then + if !dbg_Tac then BU.print2 "About to preprocess %s |= %s\n" (Env.all_binders env |> Print.binders_to_string ",") (show goal); @@ -313,7 +315,7 @@ let preprocess (env:Env.env) (goal:term) | Simplified (t', gs) -> true, (t', gs) | _ -> failwith "preprocess: impossible, traverse returned a Dual" in - if !tacdbg then + if !dbg_Tac then BU.print2 "Main goal simplified to: %s |- %s\n" (Env.all_binders env |> Print.binders_to_string ", ") (show t'); @@ -325,7 +327,7 @@ let preprocess (env:Env.env) (goal:term) (BU.format1 "Tactic returned proof-relevant goal: %s" (show (goal_type g)))) env.range | Some phi -> phi in - if !tacdbg then + if !dbg_Tac then BU.print2 "Got goal #%s: %s\n" (show n) (show (goal_type g)); let label = let open FStar.Pprint in @@ -348,8 +350,7 @@ let rec traverse_for_spinoff (label_ctx:option (list Pprint.document & Range.range)) (e:Env.env) (t:term) : tres = - let debug_any = Options.debug_any () in - let debug = Env.debug e (O.Other "SpinoffAll") in + let debug_any = Debug.any () in let traverse pol e t = traverse_for_spinoff pol label_ctx e t in let traverse_ctx pol (ctx : list Pprint.document & Range.range) (e:Env.env) (t:term) : tres = let print_lc (msg, rng) = @@ -358,7 +359,7 @@ let rec traverse_for_spinoff (Range.string_of_use_range rng) (Errors.Msg.rendermsg msg) in - if debug + if !dbg_SpinoffAll then BU.print2 "Changing label context from %s to %s" (match label_ctx with | None -> "None" @@ -410,7 +411,7 @@ let rec traverse_for_spinoff let spinoff t = match pol with | StrictlyPositive -> - if debug then BU.print1 "Spinning off %s\n" (show t); + if !dbg_SpinoffAll then BU.print1 "Spinning off %s\n" (show t); Simplified (FStar.Syntax.Util.t_true, [label_goal (e,t)]) | _ -> @@ -583,7 +584,7 @@ let rec traverse_for_spinoff U.eq_tm t U.t_true = U.Equal -> //simplify squash True to True //important for simplifying queries to Trivial - if debug then BU.print_string "Simplified squash True to True"; + if !dbg_SpinoffAll then BU.print_string "Simplified squash True to True"; U.t_true.n | _ -> @@ -629,8 +630,7 @@ let pol_to_string = function let spinoff_strictly_positive_goals (env:Env.env) (goal:term) : list (Env.env * term) - = let debug = Env.debug env (O.Other "SpinoffAll") in - if debug then BU.print1 "spinoff_all called with %s\n" (show goal); + = if !dbg_SpinoffAll then BU.print1 "spinoff_all called with %s\n" (show goal); Errors.with_ctx "While spinning off all goals" (fun () -> let initial = (1, []) in // This match should never fail @@ -648,7 +648,7 @@ let spinoff_strictly_positive_goals (env:Env.env) (goal:term) match t with | Trivial -> [] | NonTrivial t -> - if debug + if !dbg_SpinoffAll then ( let msg = BU.format2 "Main goal simplified to: %s |- %s\n" (Env.all_binders env |> Print.binders_to_string ", ") @@ -682,7 +682,7 @@ let spinoff_strictly_positive_goals (env:Env.env) (goal:term) match FStar.TypeChecker.Common.check_trivial t with | Trivial -> None | NonTrivial t -> - if debug + if !dbg_SpinoffAll then BU.print1 "Got goal: %s\n" (show t); Some (env, t)) in @@ -700,7 +700,6 @@ let synthesize (env:Env.env) (typ:typ) (tau:term) : term = if env.nosynth then mk_Tm_app (TcUtil.fvar_env env PC.magic_lid) [S.as_arg U.exp_unit] typ.pos else begin - tacdbg := Env.debug env (O.Other "Tac"); let gs, w = run_tactic_on_typ tau.pos typ.pos tau env typ in // Check that all goals left are irrelevant and provable @@ -710,7 +709,7 @@ let synthesize (env:Env.env) (typ:typ) (tau:term) : term = match getprop (goal_env g) (goal_type g) with | Some vc -> begin - if !tacdbg then + if !dbg_Tac then BU.print1 "Synthesis left a goal: %s\n" (show vc); let guard = { guard_f = NonTrivial vc ; deferred_to_tac = [] @@ -729,7 +728,6 @@ let solve_implicits (env:Env.env) (tau:term) (imps:Env.implicits) : unit = Errors.with_ctx "While solving implicits with a tactic" (fun () -> if env.nosynth then () else begin - tacdbg := Env.debug env (O.Other "Tac"); let gs = run_tactic_on_all_implicits tau.pos (Env.get_range env) tau env imps in // Check that all goals left are irrelevant and provable @@ -745,7 +743,7 @@ let solve_implicits (env:Env.env) (tau:term) (imps:Env.implicits) : unit = match getprop (goal_env g) (goal_type g) with | Some vc -> begin - if !tacdbg then + if !dbg_Tac then BU.print1 "Synthesis left a goal: %s\n" (show vc); if not (Options.admit_smt_queries()) then ( @@ -796,7 +794,6 @@ let handle_smt_goal env goal = in let gs = Errors.with_ctx "While handling an SMT goal with a tactic" (fun () -> - tacdbg := Env.debug env (O.Other "Tac"); (* Executing the tactic on the goal. *) let gs, _ = run_tactic_on_typ tau.pos (Env.get_range env) tau env (U.mk_squash U_zero goal) in @@ -804,7 +801,7 @@ let handle_smt_goal env goal = gs |> List.map (fun g -> match getprop (goal_env g) (goal_type g) with | Some vc -> - if !tacdbg then + if !dbg_Tac then BU.print1 "handle_smt_goals left a goal: %s\n" (show vc); (goal_env g), vc | None -> @@ -836,7 +833,6 @@ let splice Errors.with_ctx "While running splice with a tactic" (fun () -> if env.nosynth then [] else begin - tacdbg := Env.debug env (O.Other "Tac"); let tau, _, g = if is_typed @@ -936,7 +932,7 @@ let splice match getprop (goal_env g) (goal_type g) with | Some vc -> begin - if !tacdbg then + if !dbg_Tac then BU.print1 "Splice left a goal: %s\n" (show vc); let guard = { guard_f = NonTrivial vc ; deferred_to_tac = [] @@ -961,7 +957,7 @@ let splice | _ -> () ) lids; - if !tacdbg then + if !dbg_Tac then BU.print1 "splice: got decls = {\n\n%s\n\n}\n" (show sigelts); (* Check for bare Sig_datacon and Sig_inductive_typ, and abort if so. Also set range. *) @@ -997,7 +993,6 @@ let splice let mpreprocess (env:Env.env) (tau:term) (tm:term) : term = Errors.with_ctx "While preprocessing a definition with a tactic" (fun () -> if env.nosynth then tm else begin - tacdbg := Env.debug env (O.Other "Tac"); let ps = FStar.Tactics.V2.Basic.proofstate_of_goals tm.pos env [] [] in let tactic_already_typed = false in let gs, tm = run_tactic_on_ps tau.pos tm.pos false RE.e_term tm RE.e_term tau tactic_already_typed ps in @@ -1008,7 +1003,6 @@ let mpreprocess (env:Env.env) (tau:term) (tm:term) : term = let postprocess (env:Env.env) (tau:term) (typ:term) (tm:term) : term = Errors.with_ctx "While postprocessing a definition with a tactic" (fun () -> if env.nosynth then tm else begin - tacdbg := Env.debug env (O.Other "Tac"); //we know that tm:typ //and we have a goal that u == tm //so if we solve that equality, we don't need to retype the solution of `u : typ` @@ -1023,7 +1017,7 @@ let postprocess (env:Env.env) (tau:term) (typ:term) (tm:term) : term = match getprop (goal_env g) (goal_type g) with | Some vc -> begin - if !tacdbg then + if !dbg_Tac then BU.print1 "Postprocessing left a goal: %s\n" (show vc); let guard = { guard_f = NonTrivial vc ; deferred_to_tac = [] diff --git a/src/tactics/FStar.Tactics.Interpreter.fst b/src/tactics/FStar.Tactics.Interpreter.fst index bcde515e2d4..a5a0430e086 100644 --- a/src/tactics/FStar.Tactics.Interpreter.fst +++ b/src/tactics/FStar.Tactics.Interpreter.fst @@ -60,8 +60,9 @@ module TcRel = FStar.TypeChecker.Rel module TcTerm = FStar.TypeChecker.TcTerm module U = FStar.Syntax.Util +let dbg_Tac = Debug.get_toggle "Tac" + let solve (#a:Type) {| ev : a |} : Tot a = ev -let tacdbg = BU.mk_ref false let embed {|embedding 'a|} r (x:'a) norm_cb = embed x r None norm_cb let unembed {|embedding 'a|} a norm_cb : option 'a = unembed a norm_cb @@ -300,7 +301,7 @@ let run_unembedded_tactic_on_ps let ps = { ps with main_context = { ps.main_context with intactics = true } } in let ps = { ps with main_context = { ps.main_context with range = rng_goal } } in let env = ps.main_context in - (* if !tacdbg then *) + (* if !dbg_Tac then *) (* BU.print1 "Running tactic with goal = (%s) {\n" (show typ); *) let res = Profiling.profile @@ -308,15 +309,15 @@ let run_unembedded_tactic_on_ps (Some (Ident.string_of_lid (Env.current_module ps.main_context))) "FStar.Tactics.Interpreter.run_safe" in - if !tacdbg then + if !dbg_Tac then BU.print_string "}\n"; match res with | Success (ret, ps) -> - if !tacdbg then + if !dbg_Tac then do_dump_proofstate ps "at the finish line"; - (* if !tacdbg || Options.tactics_info () then *) + (* if !dbg_Tac || Options.tactics_info () then *) (* BU.print1 "Tactic generated proofterm %s\n" (show w); *) let remaining_smt_goals = ps.goals@ps.smt_goals in List.iter @@ -324,7 +325,7 @@ let run_unembedded_tactic_on_ps mark_goal_implicit_already_checked g;//all of these will be fed to SMT anyway if is_irrelevant g then ( - if !tacdbg then BU.print1 "Assigning irrelevant goal %s\n" (show (goal_witness g)); + if !dbg_Tac then BU.print1 "Assigning irrelevant goal %s\n" (show (goal_witness g)); if TcRel.teq_nosmt_force (goal_env g) (goal_witness g) U.exp_unit then () else failwith (BU.format1 "Irrelevant tactic witness does not unify with (): %s" @@ -334,19 +335,19 @@ let run_unembedded_tactic_on_ps // Check that all implicits were instantiated Errors.with_ctx "While checking implicits left by a tactic" (fun () -> - if !tacdbg then + if !dbg_Tac then BU.print1 "About to check tactic implicits: %s\n" (FStar.Common.string_of_list (fun imp -> show imp.imp_uvar) ps.all_implicits); let g = {Env.trivial_guard with TcComm.implicits=ps.all_implicits} in let g = TcRel.solve_deferred_constraints env g in - if !tacdbg then + if !dbg_Tac then BU.print2 "Checked %s implicits (1): %s\n" (show (List.length ps.all_implicits)) (show ps.all_implicits); let tagged_implicits = TcRel.resolve_implicits_tac env g in - if !tacdbg then + if !dbg_Tac then BU.print2 "Checked %s implicits (2): %s\n" (show (List.length ps.all_implicits)) (show ps.all_implicits); @@ -406,7 +407,7 @@ let run_tactic_on_ps' * 'b // return value = let env = ps.main_context in - if !tacdbg then + if !dbg_Tac then BU.print2 "Typechecking tactic: (%s) (already_typed: %s) {\n" (show tactic) (show tactic_already_typed); @@ -421,7 +422,7 @@ let run_tactic_on_ps' g in - if !tacdbg then + if !dbg_Tac then BU.print_string "}\n"; TcRel.force_trivial_guard env g; diff --git a/src/tactics/FStar.Tactics.Interpreter.fsti b/src/tactics/FStar.Tactics.Interpreter.fsti index 7be4c054309..e24ebb9f649 100644 --- a/src/tactics/FStar.Tactics.Interpreter.fsti +++ b/src/tactics/FStar.Tactics.Interpreter.fsti @@ -52,9 +52,6 @@ val report_implicits : range -> FStar.TypeChecker.Rel.tagged_implicits -> unit (* Called by Main *) val register_tactic_primitive_step : FStar.TypeChecker.Primops.primitive_step -> unit -(* For debugging only *) -val tacdbg : ref bool - open FStar.Tactics.Monad module NBET = FStar.TypeChecker.NBETerm val e_tactic_thunk (er : embedding 'r) : embedding (tac 'r) diff --git a/src/tactics/FStar.Tactics.Monad.fst b/src/tactics/FStar.Tactics.Monad.fst index 838dcd834cf..95705ad02b3 100644 --- a/src/tactics/FStar.Tactics.Monad.fst +++ b/src/tactics/FStar.Tactics.Monad.fst @@ -45,6 +45,11 @@ module Env = FStar.TypeChecker.Env module Rel = FStar.TypeChecker.Rel module Core = FStar.TypeChecker.Core +let dbg_Core = Debug.get_toggle "Core" +let dbg_CoreEq = Debug.get_toggle "CoreEq" +let dbg_RegisterGoal = Debug.get_toggle "RegisterGoal" +let dbg_TacFail = Debug.get_toggle "TacFail" + let goal_ctr = BU.mk_ref 0 let get_goal_ctr () = !goal_ctr let incr_goal_ctr () = let v = !goal_ctr in goal_ctr := v + 1; v @@ -69,21 +74,19 @@ let register_goal (g:goal) = let i = Core.incr_goal_ctr () in if Allow_untyped? (U.ctx_uvar_should_check g.goal_ctx_uvar) then () else let env = {env with gamma = uv.ctx_uvar_gamma } in - if Env.debug env <| Options.Other "CoreEq" + if !dbg_CoreEq then BU.print1 "(%s) Registering goal\n" (show i); let should_register = is_goal_safe_as_well_typed g in if not should_register then ( - if Env.debug env <| Options.Other "Core" - || Env.debug env <| Options.Other "RegisterGoal" + if !dbg_Core || !dbg_RegisterGoal then BU.print1 "(%s) Not registering goal since it has unresolved uvar deps\n" (show i); () ) else ( - if Env.debug env <| Options.Other "Core" - || Env.debug env <| Options.Other "RegisterGoal" + if !dbg_Core || !dbg_RegisterGoal then BU.print2 "(%s) Registering goal for %s\n" (show i) (show uv); @@ -153,7 +156,7 @@ let log ps (f : unit -> unit) : unit = let fail_doc (msg:error_message) = mk_tac (fun ps -> - if Env.debug ps.main_context (Options.Other "TacFail") then + if !dbg_TacFail then do_dump_proofstate ps ("TACTIC FAILING: " ^ renderdoc (hd msg)); Failed (TacticFailure msg, ps) ) diff --git a/src/tactics/FStar.Tactics.Printing.fst b/src/tactics/FStar.Tactics.Printing.fst index 92790499d68..3a0c4933b3d 100644 --- a/src/tactics/FStar.Tactics.Printing.fst +++ b/src/tactics/FStar.Tactics.Printing.fst @@ -38,6 +38,8 @@ module U = FStar.Syntax.Util module Cfg = FStar.TypeChecker.Cfg module PO = FStar.TypeChecker.Primops +let dbg_Imp = Debug.get_toggle "Imp" + let term_to_string (e:Env.env) (t:term) : string = Print.term_to_string' e.dsenv t @@ -136,7 +138,7 @@ let ps_to_string (msg, ps) = (if ps.entry_range <> Range.dummyRange then BU.format1 "Location: %s\n" (Range.string_of_def_range ps.entry_range) else ""); - (if Env.debug ps.main_context (Options.Other "Imp") + (if !dbg_Imp then BU.format1 "Imps: %s\n" (FStar.Common.string_of_list p_imp ps.all_implicits) else "")] @ (List.mapi (fun i g -> goal_to_string "Goal" (Some (1 + i, n)) ps g) ps.goals) diff --git a/src/tactics/FStar.Tactics.V1.Basic.fst b/src/tactics/FStar.Tactics.V1.Basic.fst index af44859d630..eb1885697f0 100644 --- a/src/tactics/FStar.Tactics.V1.Basic.fst +++ b/src/tactics/FStar.Tactics.V1.Basic.fst @@ -62,6 +62,11 @@ module PO = FStar.TypeChecker.Primops open FStar.Class.Monad open FStar.Class.Setlike +let dbg_2635 = Debug.get_toggle "2635" +let dbg_ReflTc = Debug.get_toggle "ReflTc" +let dbg_Tac = Debug.get_toggle "Tac" +let dbg_TacUnify = Debug.get_toggle "TacUnify" + let ret #a (x:a) : tac a = return x let bind #a #b : tac a -> (a -> tac b) -> tac b = ( let! ) let idtac : tac unit = return () @@ -77,7 +82,7 @@ let core_check env sol t must_tot : either (option typ) Core.error = if not (Options.compat_pre_core_should_check()) then Inl None else let debug f = - if Options.debug_any() + if Debug.any() then f () else () in @@ -156,7 +161,7 @@ let print (msg:string) : tac unit = let debugging () : tac bool = bind get (fun ps -> - ret (Env.debug ps.main_context (Options.Other "Tac"))) + ret !dbg_Tac) let do_dump_ps (msg:string) (ps:proofstate) : unit = let psc = ps.psc in @@ -433,15 +438,14 @@ let __do_unify (check_side:check_unifier_solved_implicits_side) (env:env) (t1:term) (t2:term) : tac (option guard_t) = - let dbg = Env.debug env (Options.Other "TacUnify") in bind idtac (fun () -> - if dbg then begin + if !dbg_TacUnify then begin Options.push (); - let _ = Options.set_options "--debug_level Rel --debug_level RelCheck" in + let _ = Options.set_options "--debug Rel,RelCheck" in () end; - bind (__do_unify_wflags dbg allow_guards must_tot check_side env t1 t2) (fun r -> - if dbg then Options.pop (); + bind (__do_unify_wflags !dbg_TacUnify allow_guards must_tot check_side env t1 t2) (fun r -> + if !dbg_TacUnify then Options.pop (); ret r)) (* SMT-free unification. *) @@ -742,7 +746,7 @@ let intro () : tac binder = wrap_err "intro" <| ( //BU.print1 "[intro]: old goal is %s" (goal_to_string goal); //BU.print1 "[intro]: new goal is %s" // (show ctx_uvar); - //ignore (FStar.Options.set_options "--debug_level Rel"); + //ignore (FStar.Options.set_options "--debug Rel"); (* Suppose if instead of simply assigning `?u` to the lambda term on the RHS, we tried to unify `?u` with the `(fun (x:t) -> ?v @ [NM(x, 0)])`. @@ -1069,7 +1073,7 @@ let t_apply_lemma (noinst:bool) (noinst_lhs:bool) |> Some) deps (rangeof goal) in - if Env.debug env <| Options.Other "2635" + if Debug.medium () || !dbg_2635 then BU.print2 "Apply lemma created a new uvar %s while applying %s\n" (show u) @@ -2295,7 +2299,7 @@ let free_uvars (tm : term) : tac (list Z.t) (***** Builtins used in the meta DSL framework *****) let dbg_refl (g:env) (msg:unit -> string) = - if Env.debug g <| Options.Other "ReflTc" + if !dbg_ReflTc then BU.print_string (msg ()) let issues = list Errors.issue diff --git a/src/tactics/FStar.Tactics.V2.Basic.fst b/src/tactics/FStar.Tactics.V2.Basic.fst index 48bbf3ff425..c30dbb101e4 100644 --- a/src/tactics/FStar.Tactics.V2.Basic.fst +++ b/src/tactics/FStar.Tactics.V2.Basic.fst @@ -60,6 +60,11 @@ module Z = FStar.BigInt module Core = FStar.TypeChecker.Core module PO = FStar.TypeChecker.Primops +let dbg_TacUnify = Debug.get_toggle "TacUnify" +let dbg_2635 = Debug.get_toggle "2635" +let dbg_ReflTc = Debug.get_toggle "ReflTc" +let dbg_TacVerbose = Debug.get_toggle "TacVerbose" + open FStar.Class.Show open FStar.Class.Monad open FStar.Class.PP @@ -73,7 +78,7 @@ let core_check env sol t must_tot : either (option typ) Core.error = if not (Options.compat_pre_core_should_check()) then Inl None else let debug f = - if Options.debug_any() + if Debug.any() then f () else () in @@ -127,9 +132,10 @@ let print (msg:string) : tac unit = tacprint msg; return () +let dbg_Tac = Debug.get_toggle "Tac" let debugging () : tac bool = let! ps = get in - return (Env.debug ps.main_context (Options.Other "Tac")) + return !dbg_Tac let do_dump_ps (msg:string) (ps:proofstate) : unit = let psc = ps.psc in @@ -415,15 +421,14 @@ let __do_unify (check_side:check_unifier_solved_implicits_side) (env:env) (t1:term) (t2:term) : tac (option guard_t) = - let dbg = Env.debug env (Options.Other "TacUnify") in return ();! - if dbg then begin + if !dbg_TacUnify then begin Options.push (); - let _ = Options.set_options "--debug_level Rel --debug_level RelCheck" in + let _ = Options.set_options "--debug Rel,RelCheck" in () end; - let! r = __do_unify_wflags dbg allow_guards must_tot check_side env t1 t2 in - if dbg then Options.pop (); + let! r = __do_unify_wflags !dbg_TacUnify allow_guards must_tot check_side env t1 t2 in + if !dbg_TacUnify then Options.pop (); return r (* SMT-free unification. *) @@ -741,7 +746,7 @@ let intro () : tac RD.binding = wrap_err "intro" <| ( //BU.print1 "[intro]: old goal is %s" (goal_to_string goal); //BU.print1 "[intro]: new goal is %s" // (show ctx_uvar); - //ignore (FStar.Options.set_options "--debug_level Rel"); + //ignore (FStar.Options.set_options "--debug Rel"); (* Suppose if instead of simply assigning `?u` to the lambda term on the RHS, we tried to unify `?u` with the `(fun (x:t) -> ?v @ [NM(x, 0)])`. @@ -1065,7 +1070,7 @@ let t_apply_lemma (noinst:bool) (noinst_lhs:bool) |> Some) deps (rangeof goal) in - if Env.debug env <| Options.Other "2635" + if !dbg_2635 then BU.print2 "Apply lemma created a new uvar %s while applying %s\n" (show u) @@ -2143,7 +2148,7 @@ let write (r:tref 'a) (x:'a) : tac unit = (***** Builtins used in the meta DSL framework *****) let dbg_refl (g:env) (msg:unit -> string) = - if Env.debug g <| Options.Other "ReflTc" + if !dbg_ReflTc then BU.print_string (msg ()) let issues = list Errors.issue @@ -2789,7 +2794,7 @@ let proofstate_of_goals rng env goals imps = entry_range = rng; guard_policy = SMT; freshness = 0; - tac_verb_dbg = Env.debug env (Options.Other "TacVerbose"); + tac_verb_dbg = !dbg_TacVerbose; local_state = BU.psmap_empty (); urgency = 1; dump_on_failure = true; @@ -2819,7 +2824,7 @@ let proofstate_of_all_implicits rng env imps = entry_range = rng; guard_policy = SMT; freshness = 0; - tac_verb_dbg = Env.debug env (Options.Other "TacVerbose"); + tac_verb_dbg = !dbg_TacVerbose; local_state = BU.psmap_empty (); urgency = 1; dump_on_failure = true; diff --git a/src/tests/FStar.Tests.Norm.fst b/src/tests/FStar.Tests.Norm.fst index 7b803e69819..07e601e7454 100644 --- a/src/tests/FStar.Tests.Norm.fst +++ b/src/tests/FStar.Tests.Norm.fst @@ -264,7 +264,7 @@ let run_either i r expected normalizer = Options.set_option "print_implicits" (Options.Bool true); Options.set_option "ugly" (Options.Bool true); Options.set_option "print_bound_var_types" (Options.Bool true); - // ignore (Options.set_options "--debug Test --debug_level univ_norm --debug_level NBE"); + // ignore (Options.set_options "--debug Test --debug univ_norm,NBE"); always i (term_eq (U.unascribe x) expected) let run_whnf i r expected = diff --git a/src/tests/FStar.Tests.Unif.fst b/src/tests/FStar.Tests.Unif.fst index a6fe86d36c6..5f103c74beb 100644 --- a/src/tests/FStar.Tests.Unif.fst +++ b/src/tests/FStar.Tests.Unif.fst @@ -197,7 +197,6 @@ let run_all () = FStar.Main.process_args () |> ignore; //set options let tm, us = inst 1 (tc "fun (u:Type0 -> Type0) (x:Type0) -> u x") in let sol = tc "fun (x:Type0) -> Prims.pair x x" in - BU.print1 "Processed args: debug_at_level Core? %s\n" (BU.string_of_bool (Options.debug_at_level_no_module (Options.Other "Core"))); unify_check 9 [] tm sol Trivial diff --git a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst index 22741ad38e5..a0a2c8c02bc 100644 --- a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst +++ b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst @@ -41,6 +41,8 @@ module P = FStar.Syntax.Print module EMB = FStar.Syntax.Embeddings module SS = FStar.Syntax.Subst +let dbg_attrs = Debug.get_toggle "attrs" + type antiquotations_temp = list (bv * S.term) let tun_r (r:Range.range) : S.term = { tun with pos = r } @@ -3141,7 +3143,7 @@ let rec desugar_tycon env (d: AST.decl) (d_attrs:list S.term) quals tcs : (env_t sigopens_and_abbrevs = opens_and_abbrevs env })))) in - if Options.debug_at_level_no_module (Options.Other "attrs") + if !dbg_attrs then ( BU.print3 "Adding attributes to type %s: val_attrs=[@@%s] attrs=[@@%s]\n" (string_of_lid tname) @@ -3166,7 +3168,7 @@ let rec desugar_tycon env (d: AST.decl) (d_attrs:list S.term) quals tcs : (env_t in let sigelts = tps_sigelts |> List.map (fun (_, se) -> se) in let bundle, abbrevs = FStar.Syntax.MutRecTy.disentangle_abbrevs_from_bundle sigelts quals (List.collect U.lids_of_sigelt sigelts) rng in - if Options.debug_at_level_no_module (Options.Other "attrs") + if !dbg_attrs then ( BU.print1 "After disentangling: %s\n" (Print.sigelt_to_string bundle) @@ -3728,7 +3730,7 @@ and desugar_decl_core env (d_attrs:list S.term) (d:decl) : (env_t * sigelts) = else quals in let env, ses = desugar_tycon env d d_attrs (List.map (trans_qual None) quals) tcs in - if Options.debug_at_level_no_module (Options.Other "attrs") + if !dbg_attrs then ( BU.print2 "Desugared tycon from {%s} to {%s}\n" (FStar.Parser.AST.decl_to_string d) diff --git a/src/typechecker/FStar.TypeChecker.Cfg.fst b/src/typechecker/FStar.TypeChecker.Cfg.fst index 5cb7254d97d..95f03a6d954 100644 --- a/src/typechecker/FStar.TypeChecker.Cfg.fst +++ b/src/typechecker/FStar.TypeChecker.Cfg.fst @@ -282,8 +282,9 @@ let log_cfg cfg f = let log_primops cfg f = if cfg.debug.primop then f () else () +let dbg_unfolding = Debug.get_toggle "Unfolding" let log_unfolding cfg f = - if cfg.debug.unfolding then f () else () + if !dbg_unfolding then f () else () let log_nbe cfg f = if cfg.debug.debug_nbe then f () @@ -358,6 +359,17 @@ let add_nbe s = // ZP : Turns nbe flag on, to be used as the default norm strate then { s with nbe_step = true } else s +let dbg_Norm = Debug.get_toggle "Norm" +let dbg_NormTop = Debug.get_toggle "NormTop" +let dbg_NormCfg = Debug.get_toggle "NormCfg" +let dbg_Primops = Debug.get_toggle "Primops" +let dbg_Unfolding = Debug.get_toggle "Unfolding" +let dbg_380 = Debug.get_toggle "380" +let dbg_WPE = Debug.get_toggle "WPE" +let dbg_NormDelayed = Debug.get_toggle "NormDelayed" +let dbg_print_normalized = Debug.get_toggle "print_normalized_terms" +let dbg_NBE = Debug.get_toggle "NBE" +let dbg_UNSOUND_EraseErasableArgs = Debug.get_toggle "UNSOUND_EraseErasableArgs" let config' psteps s e = let d = s |> List.collect (function @@ -375,37 +387,33 @@ let config' psteps s e = let steps = to_fsteps s |> add_nbe in let psteps = add_steps (cached_steps ()) psteps in let dbg_flag = List.contains NormDebug s in - {tcenv = e; - debug = if dbg_flag || Options.debug_any () then - { gen = Env.debug e (Options.Other "Norm") || dbg_flag - ; top = Env.debug e (Options.Other "NormTop") || dbg_flag - ; cfg = Env.debug e (Options.Other "NormCfg") - ; primop = Env.debug e (Options.Other "Primops") - ; unfolding = Env.debug e (Options.Other "Unfolding") - ; b380 = Env.debug e (Options.Other "380") - ; wpe = Env.debug e (Options.Other "WPE") - ; norm_delayed = Env.debug e (Options.Other "NormDelayed") - ; print_normalized = Env.debug e (Options.Other "print_normalized_terms") - ; debug_nbe = Env.debug e (Options.Other "NBE") - ; erase_erasable_args = - (let b = Env.debug e (Options.Other "UNSOUND_EraseErasableArgs") in - if b - then Errors.log_issue - (Env.get_range e) - (Errors.Warning_WarnOnUse, - "The 'UNSOUND_EraseErasableArgs' setting is for debugging only; it is not sound"); - b) - } - else no_debug_switches - ; - steps = steps; - delta_level = d; - primitive_steps = psteps; - strong = false; - memoize_lazy = true; - normalize_pure_lets = (not steps.pure_subterms_within_computations) || Options.normalize_pure_terms_for_extraction(); - reifying = false; - compat_memo_ignore_cfg = Options.ext_getv "compat:normalizer_memo_ignore_cfg" <> ""; + { + tcenv = e; + debug = { + gen = !dbg_Norm || dbg_flag; + top = !dbg_NormTop || dbg_flag; + cfg = !dbg_NormCfg; + primop = !dbg_Primops; + unfolding = !dbg_Unfolding; + b380 = !dbg_380; + wpe = !dbg_WPE; + norm_delayed = !dbg_NormDelayed; + print_normalized = !dbg_print_normalized; + debug_nbe = !dbg_NBE; + erase_erasable_args = ( + if !dbg_UNSOUND_EraseErasableArgs then + Errors.log_issue (Env.get_range e) (Errors.Warning_WarnOnUse, + "The 'UNSOUND_EraseErasableArgs' setting is for debugging only; it is not sound"); + !dbg_UNSOUND_EraseErasableArgs); + }; + steps = steps; + delta_level = d; + primitive_steps = psteps; + strong = false; + memoize_lazy = true; + normalize_pure_lets = (not steps.pure_subterms_within_computations) || Options.normalize_pure_terms_for_extraction(); + reifying = false; + compat_memo_ignore_cfg = Options.ext_getv "compat:normalizer_memo_ignore_cfg" <> ""; } let config s e = config' [] s e diff --git a/src/typechecker/FStar.TypeChecker.Core.fst b/src/typechecker/FStar.TypeChecker.Core.fst index 9ee5513a596..084de6eb176 100644 --- a/src/typechecker/FStar.TypeChecker.Core.fst +++ b/src/typechecker/FStar.TypeChecker.Core.fst @@ -19,6 +19,11 @@ module Subst = FStar.Syntax.Subst open FStar.Class.Show open FStar.Class.Setlike +let dbg = Debug.get_toggle "Core" +let dbg_Eq = Debug.get_toggle "CoreEq" +let dbg_Top = Debug.get_toggle "CoreTop" +let dbg_Exit = Debug.get_toggle "CoreExit" + let goal_ctr = BU.mk_ref 0 let get_goal_ctr () = !goal_ctr let incr_goal_ctr () = let v = !goal_ctr in goal_ctr := v + 1; v + 1 @@ -699,7 +704,7 @@ let unfolding_ok = fun ctx -> Success (ctx.unfolding_ok, None) let debug g f = - if Env.debug g.tcenv (Options.Other "Core") + if !dbg then f () instance showable_side = { @@ -773,7 +778,7 @@ let rec check_relation (g:env) (rel:relation) (t0 t1:typ) | EQUALITY -> "=?=" | SUBTYPING _ -> "<:?" in - if Env.debug g.tcenv (Options.Other "Core") + if !dbg then BU.print5 "check_relation (%s) %s %s (%s) %s\n" (P.tag_of_term t0) (show t0) @@ -940,7 +945,7 @@ let rec check_relation (g:env) (rel:relation) (t0 t1:typ) else ( match! maybe_unfold x0.sort x1.sort with | None -> - if Env.debug g.tcenv (Options.Other "Core") then + if !dbg then BU.print2 "Cannot match ref heads %s and %s\n" (show x0.sort) (show x1.sort); fallback t0 t1 | Some (t0, t1) -> @@ -1836,12 +1841,11 @@ let simplify_steps = let check_term_top_gh g e topt (must_tot:bool) (gh:option guard_handler_t) : __result ((tot_or_ghost & S.typ) & precondition) - = if Env.debug g (Options.Other "CoreEq") + = if !dbg_Eq then BU.print1 "(%s) Entering core ... \n" (BU.string_of_int (get_goal_ctr())); - if Env.debug g (Options.Other "Core") - || Env.debug g (Options.Other "CoreTop") + if !dbg || !dbg_Top then BU.print3 "(%s) Entering core with %s <: %s\n" (BU.string_of_int (get_goal_ctr())) (P.term_to_string e) @@ -1863,12 +1867,10 @@ let check_term_top_gh g e topt (must_tot:bool) (gh:option guard_handler_t) match res with | Success (et, Some guard0) -> // Options.push(); - // Options.set_option "debug_level" (Options.List [Options.String "Unfolding"]); + // Options.set_option "debug" (Options.List [Options.String "Unfolding"]); let guard = N.normalize simplify_steps g guard0 in // Options.pop(); - if Env.debug g (Options.Other "CoreExit") - || Env.debug g (Options.Other "Core") - || Env.debug g (Options.Other "CoreTop") + if !dbg || !dbg_Top || !dbg_Exit then begin BU.print3 "(%s) Exiting core: Simplified guard from {{%s}} to {{%s}}\n" (BU.string_of_int (get_goal_ctr())) @@ -1886,20 +1888,18 @@ let check_term_top_gh g e topt (must_tot:bool) (gh:option guard_handler_t) Success (et, Some guard) | Success _ -> - if Env.debug g (Options.Other "Core") - || Env.debug g (Options.Other "CoreTop") + if !dbg || !dbg_Top then BU.print1 "(%s) Exiting core (ok)\n" (BU.string_of_int (get_goal_ctr())); res | Error _ -> - if Env.debug g (Options.Other "Core") - || Env.debug g (Options.Other "CoreTop") + if !dbg || !dbg_Top then BU.print1 "(%s) Exiting core (failed)\n" (BU.string_of_int (get_goal_ctr())); res in - if Env.debug g (Options.Other "CoreEq") + if !dbg_Eq then ( THT.print_stats table; let cs = report_cache_stats() in @@ -1941,12 +1941,12 @@ let open_binders_in_comp (env:Env.env) (bs:binders) (c:comp) = let check_term_equality guard_ok unfolding_ok g t0 t1 = let g = initial_env g None in - if Env.debug g.tcenv (Options.Other "CoreTop") then + if !dbg_Top then BU.print4 "Entering check_term_equality with %s and %s (guard_ok=%s; unfolding_ok=%s) {\n" (show t0) (show t1) (show guard_ok) (show unfolding_ok); let ctx = { unfolding_ok = unfolding_ok; no_guard = not guard_ok; error_context = [("Eq", None)] } in let r = check_relation g EQUALITY t0 t1 ctx in - if Env.debug g.tcenv (Options.Other "CoreTop") then + if !dbg_Top then BU.print3 "} Exiting check_term_equality (%s, %s). Result = %s.\n" (show t0) (show t1) (show r); let r = match r with diff --git a/src/typechecker/FStar.TypeChecker.DMFF.fst b/src/typechecker/FStar.TypeChecker.DMFF.fst index 8f57bc3b632..7912022395a 100644 --- a/src/typechecker/FStar.TypeChecker.DMFF.fst +++ b/src/typechecker/FStar.TypeChecker.DMFF.fst @@ -43,13 +43,15 @@ module PC = FStar.Parser.Const open FStar.Class.Setlike +let dbg = Debug.get_toggle "ED" + let d s = BU.print1 "\x1b[01;36m%s\x1b[00m\n" s // Takes care of creating the [fv], generating the top-level let-binding, and // return a term that's a suitable reference (a [Tm_fv]) to the definition let mk_toplevel_definition (env: env_t) lident (def: term): sigelt * term = // Debug - if Env.debug env (Options.Other "ED") then begin + if !dbg then begin d (string_of_lid lident); BU.print2 "Registering top-level definition: %s\n%s\n" (string_of_lid lident) (Print.term_to_string def) end; @@ -84,7 +86,7 @@ let gen_wps_for_free // Debugging let d s = BU.print1 "\x1b[01;36m%s\x1b[00m\n" s in - if Env.debug env (Options.Other "ED") then begin + if !dbg then begin d "Elaborating extra WP combinators"; BU.print1 "wp_a is: %s\n" (Print.term_to_string wp_a) end; @@ -122,7 +124,7 @@ let gen_wps_for_free let mk_lid name : lident = U.dm4f_lid ed name in let gamma = collect_binders wp_a |> U.name_binders in - if Env.debug env (Options.Other "ED") then + if !dbg then d (BU.format1 "Gamma is %s\n" (Print.binders_to_string ", " gamma)); let unknown = S.tun in let mk x = mk x Range.dummyRange in @@ -479,7 +481,7 @@ let gen_wps_for_free let wp_trivial = register env (mk_lid "wp_trivial") wp_trivial in let wp_trivial = mk_generic_app wp_trivial in - if Env.debug env (Options.Other "ED") then + if !dbg then d "End Dijkstra monads for free"; let c = close binders in @@ -1362,10 +1364,10 @@ let trans_F (env: env_) (c: typ) (wp: term): term = // A helper to check that the terms elaborated by DMFF are well-typed let recheck_debug (s:string) (env:FStar.TypeChecker.Env.env) (t:S.term) : S.term = - if Env.debug env (Options.Other "ED") then + if !dbg then BU.print2 "Term has been %s-transformed to:\n%s\n----------\n" s (Print.term_to_string t); let t', _, _ = TcTerm.tc_term env t in - if Env.debug env (Options.Other "ED") then + if !dbg then BU.print1 "Re-checked; got:\n%s\n----------\n" (Print.term_to_string t'); t' @@ -1420,7 +1422,7 @@ let cps_and_elaborate (env:FStar.TypeChecker.Env.env) (ed:S.eff_decl) // TODO: check that [_comp] is [Tot Type] let repr, _comp = open_and_check env [] (ed |> U.get_eff_repr |> must |> snd) in - if Env.debug env (Options.Other "ED") then + if !dbg then BU.print1 "Representation is: %s\n" (Print.term_to_string repr); let ed_range = Env.get_range env in @@ -1559,7 +1561,7 @@ let cps_and_elaborate (env:FStar.TypeChecker.Env.env) (ed:S.eff_decl) let l' = lid_of_path p' ed_range in match try_lookup_lid env l' with | Some (_us,_t) -> begin - if Options.debug_any () then + if Debug.any () then BU.print1 "DM4F: Applying override %s\n" (string_of_lid l'); fv_to_tm (lid_and_dd_as_fv l' None) end @@ -1610,7 +1612,7 @@ let cps_and_elaborate (env:FStar.TypeChecker.Env.env) (ed:S.eff_decl) | [] -> action_typ_with_wp | _ -> flat_arrow action_params (S.mk_Total action_typ_with_wp) in - if Env.debug env <| Options.Other "ED" + if !dbg then BU.print4 "original action_params %s, end action_params %s, type %s, term %s\n" (Print.binders_to_string "," params_un) (Print.binders_to_string "," action_params) @@ -1706,7 +1708,7 @@ let cps_and_elaborate (env:FStar.TypeChecker.Env.env) (ed:S.eff_decl) // Generate the missing combinators. let sigelts', ed = gen_wps_for_free env effect_binders a wp_a ed in - if Env.debug env (Options.Other "ED") then + if !dbg then BU.print_string (Print.eff_decl_to_string true ed); let lift_from_pure_opt = diff --git a/src/typechecker/FStar.TypeChecker.Env.fst b/src/typechecker/FStar.TypeChecker.Env.fst index 49f46098a08..976e4a5a6f0 100644 --- a/src/typechecker/FStar.TypeChecker.Env.fst +++ b/src/typechecker/FStar.TypeChecker.Env.fst @@ -43,6 +43,9 @@ module TcComm = FStar.TypeChecker.Common open FStar.Defensive +let dbg_ImplicitTrace = Debug.get_toggle "ImplicitTrace" +let dbg_LayeredEffectsEqns = Debug.get_toggle "LayeredEffectsEqns" + let rec eq_step s1 s2 = match s1, s2 with | Beta, Beta @@ -344,8 +347,7 @@ let incr_query_index env = //////////////////////////////////////////////////////////// // Checking the per-module debug level and position info // //////////////////////////////////////////////////////////// -let debug env (l:Options.debug_level_t) = - Options.debug_at_level (string_of_lid env.curmodule) l + let set_range e r = if r=dummyRange then e else {e with range=r} let get_range e = e.range @@ -834,7 +836,7 @@ and delta_depth_of_fv (env:env) (fv:S.fv) : delta_depth = // a delta_equational. If we run into the same function while computing its delta_depth, // we will return delta_equational. If not, we override the cache with the correct delta_depth. let d = delta_depth_of_qninfo env fv (lookup_qname env fv.fv_name.v) in - // if Options.debug_any () then + // if Debug.any () then // BU.print2_error "Memoizing delta_depth_of_fv %s ->\t%s\n" (show lid) (show d); BU.smap_add env.fv_delta_depths (string_of_lid lid) d; d) @@ -1972,7 +1974,7 @@ let new_tac_implicit_var reason r env k should_check uvar_typedness_deps meta = ; imp_uvar = ctx_uvar ; imp_range = r } in - if debug env (Options.Other "ImplicitTrace") then + if !dbg_ImplicitTrace then BU.print1 "Just created uvar for implicit {%s}\n" (Print.uvar_to_string ctx_uvar.ctx_uvar_head); let g = {trivial_guard with implicits=[imp]} in t, [(ctx_uvar, r)], g @@ -2005,7 +2007,7 @@ let uvars_for_binders env (bs:S.binders) substs reason r = else Strict) ctx_uvar_meta_t in - if debug env <| Options.Other "LayeredEffectsEqns" + if !dbg_LayeredEffectsEqns then List.iter (fun (ctx_uvar, _) -> BU.print1 "Layered Effect uvar : %s\n" (Print.ctx_uvar_to_string ctx_uvar)) l_ctx_uvars; diff --git a/src/typechecker/FStar.TypeChecker.Env.fsti b/src/typechecker/FStar.TypeChecker.Env.fsti index 58283da8f44..a0c3eae54f6 100644 --- a/src/typechecker/FStar.TypeChecker.Env.fsti +++ b/src/typechecker/FStar.TypeChecker.Env.fsti @@ -289,7 +289,6 @@ val snapshot : env -> string -> (tcenv_depth_t * env) val rollback : solver_t -> string -> option tcenv_depth_t -> env (* Checking the per-module debug level and position info *) -val debug : env -> Options.debug_level_t -> bool val current_module : env -> lident val set_range : env -> Range.range -> env val get_range : env -> Range.range diff --git a/src/typechecker/FStar.TypeChecker.Generalize.fst b/src/typechecker/FStar.TypeChecker.Generalize.fst index 91ba89adae7..6d6a2b10d47 100644 --- a/src/typechecker/FStar.TypeChecker.Generalize.fst +++ b/src/typechecker/FStar.TypeChecker.Generalize.fst @@ -38,6 +38,8 @@ module UF = FStar.Syntax.Unionfind module Env = FStar.TypeChecker.Env module N = FStar.TypeChecker.Normalize +let dbg_Gen = Debug.get_toggle "Gen" + instance showable_univ_var : showable universe_uvar = { show = (fun u -> show (U_unif u)); } @@ -49,12 +51,12 @@ instance showable_univ_var : showable universe_uvar = { let gen_univs env (x:FlatSet.t universe_uvar) : list univ_name = if is_empty x then [] else let s = diff x (Env.univ_vars env) |> elems in // GGG: bad, order dependent - if Env.debug env <| Options.Other "Gen" then + if !dbg_Gen then BU.print1 "univ_vars in env: %s\n" (show (Env.univ_vars env)); let r = Some (Env.get_range env) in let u_names = s |> List.map (fun u -> let u_name = Syntax.new_univ_name r in - if Env.debug env <| Options.Other "Gen" then + if !dbg_Gen then BU.print3 "Setting ?%s (%s) to %s\n" (string_of_int <| UF.univ_uvar_id u) (show (U_unif u)) @@ -91,13 +93,13 @@ let generalize_universes (env:env) (t0:term) : tscheme = Errors.with_ctx "While generalizing universes" (fun () -> let t = N.normalize [Env.NoFullNorm; Env.Beta; Env.DoNotUnfoldPureLets] env t0 in let univnames = elems (gather_free_univnames env t) in /// GGG: bad, order dependent - if Env.debug env <| Options.Other "Gen" + if !dbg_Gen then BU.print2 "generalizing universes in the term (post norm): %s with univnames: %s\n" (show t) (show univnames); let univs = Free.univs t in - if Env.debug env <| Options.Other "Gen" + if !dbg_Gen then BU.print1 "univs to gen : %s\n" (show univs); let gen = gen_univs env univs in - if Env.debug env <| Options.Other "Gen" + if !dbg_Gen then BU.print2 "After generalization, t: %s and univs: %s\n" (show t) (show gen); let univs = check_universe_generalization univnames gen t0 in let t = N.reduce_uvar_solutions env t in @@ -110,10 +112,10 @@ let gen env (is_rec:bool) (lecs:list (lbname * term * comp)) : option (list (lbn then None else let norm c = - if debug env Options.Medium + if Debug.medium () then BU.print1 "Normalizing before generalizing:\n\t %s\n" (show c); let c = Normalize.normalize_comp [Env.Beta; Env.Exclude Env.Zeta; Env.NoFullNorm; Env.DoNotUnfoldPureLets] env c in - if debug env Options.Medium then + if Debug.medium () then BU.print1 "Normalized to:\n\t %s\n" (show c); c in let env_uvars = Env.uvars_in_env env in @@ -123,7 +125,7 @@ let gen env (is_rec:bool) (lecs:list (lbname * term * comp)) : option (list (lbn let t = U.comp_result c in let univs = Free.univs t in let uvt = Free.uvars t in - if Env.debug env <| Options.Other "Gen" + if !dbg_Gen then BU.print2 "^^^^\n\tFree univs = %s\n\tFree uvt=%s\n" (show univs) (show uvt); let univs = @@ -133,7 +135,7 @@ let gen env (is_rec:bool) (lecs:list (lbname * term * comp)) : option (list (lbn (elems uvt) // Bad; order dependent in let uvs = gen_uvars uvt in - if Env.debug env <| Options.Other "Gen" + if !dbg_Gen then BU.print2 "^^^^\n\tFree univs = %s\n\tgen_uvars = %s\n" (show univs) (show uvs); @@ -262,7 +264,7 @@ let gen env (is_rec:bool) (lecs:list (lbname * term * comp)) : option (list (lbn let generalize' env (is_rec:bool) (lecs:list (lbname*term*comp)) : (list (lbname*univ_names*term*comp*list binder)) = assert (List.for_all (fun (l, _, _) -> is_right l) lecs); //only generalize top-level lets - if debug env Options.Low then + if Debug.low () then BU.print1 "Generalizing: %s\n" (show <| List.map (fun (lb, _, _) -> Print.lbname_to_string lb) lecs); let univnames_lecs = @@ -278,7 +280,7 @@ let generalize' env (is_rec:bool) (lecs:list (lbname*term*comp)) : (list (lbname match gen env is_rec lecs with | None -> lecs |> List.map (fun (l,t,c) -> l,[],t,c,[]) | Some luecs -> - if debug env Options.Medium + if Debug.medium () then luecs |> List.iter (fun (l, us, e, c, gvs) -> BU.print5 "(%s) Generalized %s at type %s\n%s\nVars = (%s)\n" diff --git a/src/typechecker/FStar.TypeChecker.NBE.fst b/src/typechecker/FStar.TypeChecker.NBE.fst index 2056e1d8061..e4ac18a964f 100644 --- a/src/typechecker/FStar.TypeChecker.NBE.fst +++ b/src/typechecker/FStar.TypeChecker.NBE.fst @@ -48,6 +48,9 @@ module PC = FStar.Parser.Const open FStar.Class.Show +let dbg_NBE = Debug.get_toggle "NBE" +let dbg_NBETop = Debug.get_toggle "NBETop" + (* Broadly, the algorithm implemented here is inspired by Full Reduction at Full Throttle: @@ -1517,13 +1520,11 @@ let normalize psteps (steps:list Env.step) let cfg = Cfg.config' psteps steps env in //debug_sigmap env.sigtab; let cfg = {cfg with steps={cfg.steps with reify_=true}} in - if Env.debug env (Options.Other "NBETop") - || Env.debug env (Options.Other "NBE") + if !dbg_NBETop || !dbg_NBE then BU.print1 "Calling NBE with (%s) {\n" (P.term_to_string e); let cfg = new_config cfg in let r = readback cfg (translate cfg [] e) in - if Env.debug env (Options.Other "NBETop") - || Env.debug env (Options.Other "NBE") + if !dbg_NBETop || !dbg_NBE then BU.print1 "}\nNBE returned (%s)\n" (P.term_to_string r); r diff --git a/src/typechecker/FStar.TypeChecker.Normalize.fst b/src/typechecker/FStar.TypeChecker.Normalize.fst index 6cf52f982dc..41d921d99e7 100644 --- a/src/typechecker/FStar.TypeChecker.Normalize.fst +++ b/src/typechecker/FStar.TypeChecker.Normalize.fst @@ -52,6 +52,9 @@ module TcComm = FStar.TypeChecker.Common module PO = FStar.TypeChecker.Primops open FStar.TypeChecker.Normalize.Unfolding +let dbg_univ_norm = Debug.get_toggle "univ_norm" +let dbg_NormRebuild = Debug.get_toggle "NormRebuild" + (********************************************************************************************** * Reduction of types via the Krivine Abstract Machine (KN), with lazy * reduction and strong reduction (under binders), as described in: @@ -218,7 +221,7 @@ let norm_universe cfg (env:env) u = begin try match snd (List.nth env x) with | Univ u -> - if Env.debug cfg.tcenv <| Options.Other "univ_norm" then + if !dbg_univ_norm then BU.print1 "Univ (in norm_universe): %s\n" (Print.univ_to_string u) else (); aux u | Dummy -> [u] @@ -1155,7 +1158,7 @@ let is_forall_const cfg (phi : term) : option term = (* GM: Please consider this function private outside of this recursive * group, and call `normalize` instead. `normalize` will print timing - * information when --debug_level NormTop is given, which makes it a + * information when --debug NormTop is given, which makes it a * whole lot easier to find normalization calls that are taking a long * time. *) let rec norm : cfg -> env -> stack -> term -> term = @@ -1814,7 +1817,7 @@ and do_unfold_fv cfg stack (t0:term) (qninfo : qninfo) (f:fv) : term = if n > 0 then match stack with //universe beta reduction | UnivArgs(us', _)::stack -> - if Env.debug cfg.tcenv <| Options.Other "univ_norm" then + if !dbg_univ_norm then List.iter (fun x -> BU.print1 "Univ (normalizer) %s\n" (Print.univ_to_string x)) us' else (); let env = us' |> List.fold_left (fun env u -> (None, Univ u)::env) empty_env in @@ -2540,7 +2543,7 @@ and rebuild (cfg:cfg) (env:env) (stack:stack) (t:term) : term = (show t) (show (List.length env)) (show (fst <| firstn 4 stack)); - if Env.debug cfg.tcenv (Options.Other "NormRebuild") + if !dbg_NormRebuild then match FStar.Syntax.Util.unbound_variables t with | [] -> () | bvs -> diff --git a/src/typechecker/FStar.TypeChecker.PatternUtils.fst b/src/typechecker/FStar.TypeChecker.PatternUtils.fst index 92a96fcfcea..484f8fc9b4c 100644 --- a/src/typechecker/FStar.TypeChecker.PatternUtils.fst +++ b/src/typechecker/FStar.TypeChecker.PatternUtils.fst @@ -37,6 +37,8 @@ module U = FStar.Syntax.Util module P = FStar.Syntax.Print module C = FStar.Parser.Const +let dbg_Patterns = Debug.get_toggle "Patterns" + (************************************************************************) (* Utilities on patterns *) (************************************************************************) @@ -208,7 +210,7 @@ let pat_as_exp (introduce_bv_uvars:bool) | Pat_dot_term eopt -> (match eopt with | None -> - if Env.debug env <| Options.Other "Patterns" + if !dbg_Patterns then begin if not env.phase1 then BU.print1 "Found a non-instantiated dot pattern in phase2 (%s)\n" diff --git a/src/typechecker/FStar.TypeChecker.Positivity.fst b/src/typechecker/FStar.TypeChecker.Positivity.fst index 5db4276ffee..ce76ba58c40 100644 --- a/src/typechecker/FStar.TypeChecker.Positivity.fst +++ b/src/typechecker/FStar.TypeChecker.Positivity.fst @@ -35,6 +35,11 @@ module C = FStar.Parser.Const open FStar.Class.Setlike +let dbg_Positivity = Debug.get_toggle "Positivity" +let debug_positivity (env:env_t) (msg:unit -> string) : unit = + if !dbg_Positivity + then BU.print_string ("Positivity::" ^ msg () ^ "\n") + (** This module implements the strict positivity check on inductive type @@ -136,11 +141,6 @@ open FStar.Class.Setlike let string_of_lids lids = List.map string_of_lid lids |> String.concat ", " -(* Used extensively for verbose debugging output at debug_level Positivity *) -let debug_positivity (env:env_t) (msg:unit -> string) : unit = - if Env.debug env <| Options.Other "Positivity" - then BU.print_string ("Positivity::" ^ msg () ^ "\n") - (* Normalize a term before checking for non-strictly positive occurrences *) let normalize env t = N.normalize [Env.Beta; diff --git a/src/typechecker/FStar.TypeChecker.Rel.fst b/src/typechecker/FStar.TypeChecker.Rel.fst index 6088343ec11..5258931aae6 100644 --- a/src/typechecker/FStar.TypeChecker.Rel.fst +++ b/src/typechecker/FStar.TypeChecker.Rel.fst @@ -51,6 +51,24 @@ module PC = FStar.Parser.Const module FC = FStar.Const module TcComm = FStar.TypeChecker.Common +let dbg_Disch = Debug.get_toggle "Disch" +let dbg_Discharge = Debug.get_toggle "Discharge" +let dbg_EQ = Debug.get_toggle "EQ" +let dbg_ExplainRel = Debug.get_toggle "ExplainRel" +let dbg_GenUniverses = Debug.get_toggle "GenUniverses" +let dbg_ImplicitTrace = Debug.get_toggle "ImplicitTrace" +let dbg_Imps = Debug.get_toggle "Imps" +let dbg_LayeredEffectsApp = Debug.get_toggle "LayeredEffectsApp" +let dbg_LayeredEffectsEqns = Debug.get_toggle "LayeredEffectsEqns" +let dbg_Rel = Debug.get_toggle "Rel" +let dbg_RelBench = Debug.get_toggle "RelBench" +let dbg_RelDelta = Debug.get_toggle "RelDelta" +let dbg_RelTop = Debug.get_toggle "RelTop" +let dbg_ResolveImplicitsHook = Debug.get_toggle "ResolveImplicitsHook" +let dbg_Simplification = Debug.get_toggle "Simplification" +let dbg_SMTQuery = Debug.get_toggle "SMTQuery" +let dbg_Tac = Debug.get_toggle "Tac" + instance showable_implicit_checking_status : showable implicit_checking_status = { show = (function | Implicit_unresolved -> "Implicit_unresolved" @@ -142,8 +160,6 @@ with the problem being tackled. The uses of push_bv/push_binder should be few. *) -let debug (wl:worklist) (lvl:_) : bool = Env.debug wl.tcenv lvl - let as_deferred (wl_def:list (int * deferred_reason * lstring * prob)) : deferred = List.map (fun (_, reason, m, p) -> reason, Thunk.force m, p) wl_def @@ -175,7 +191,7 @@ let new_uvar reason wl r gamma binders k should_check meta : ctx_uvar * term * w ; imp_uvar = ctx_uvar ; imp_range = r } in - if debug wl (Options.Other "ImplicitTrace") then + if !dbg_ImplicitTrace then BU.print1 "Just created uvar (Rel) {%s}\n" (Print.uvar_to_string ctx_uvar.ctx_uvar_head); ctx_uvar, t, {wl with wl_implicits=imp::wl.wl_implicits} @@ -397,7 +413,7 @@ let empty_worklist env = { } let giveup wl (reason : lstring) prob = - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print2 "Failed %s:\n%s\n" (Thunk.force reason) (prob_to_string' wl prob); Failed (prob, reason) @@ -561,8 +577,7 @@ let guard_on_element wl problem x phi : term = | Some e -> Subst.subst [NT(x,S.bv_to_name e)] phi let explain wl d (s : lstring) = - if debug wl <| Options.Other "ExplainRel" - || debug wl <| Options.Other "Rel" + if !dbg_ExplainRel || !dbg_Rel then BU.format4 "(%s) Failed to solve the sub-problem\n%s\nWhich arose because:\n\t%s\nFailed because:%s\n" (Range.string_of_range <| p_loc d) (prob_to_string' wl d) @@ -589,7 +604,7 @@ let explain wl d (s : lstring) = let set_uvar env u (should_check_opt:option S.should_check_uvar) t = // Useful for debugging uvars setting bugs - // if Env.debug env <| Options.Other "Rel" + // if !dbg_Rel // then ( // BU.print2 "Setting uvar %s to %s\n" // (show u) @@ -914,7 +929,7 @@ let ensure_no_uvar_subst env (t0:term) (wl:worklist) (* Solve the old variable *) let args_sol = List.map U.arg_of_non_null_binder dom_binders in let sol = S.mk_Tm_app t_v args_sol t0.pos in - if Env.debug env <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "ensure_no_uvar_subst solving %s with %s\n" (show uv) (show sol); @@ -1006,7 +1021,7 @@ let solve_prob' resolve_ok prob logical_guard uvis wl = | None -> U.t_true | Some phi -> phi in let assign_solution xs uv phi = - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print3 "Solving %s (%s) with formula %s\n" (string_of_int (p_pid prob)) (show uv) @@ -1048,7 +1063,7 @@ let solve_prob' resolve_ok prob logical_guard uvis wl = {wl with ctr=wl.ctr + 1} let extend_universe_solution pid sol wl = - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Solving %s: with [%s]\n" (string_of_int pid) (uvis_to_string wl.tcenv sol); commit wl.tcenv sol; @@ -1057,7 +1072,7 @@ let extend_universe_solution pid sol wl = let solve_prob (prob : prob) (logical_guard : option term) (uvis : list uvi) (wl:worklist) : worklist = def_check_prob "solve_prob.prob" prob; BU.iter_opt logical_guard (def_check_term_scoped_in_prob "solve_prob.guard" prob); - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Solving %s: with %s\n" (string_of_int <| p_pid prob) (uvis_to_string wl.tcenv uvis); solve_prob' false prob logical_guard uvis wl @@ -1261,7 +1276,7 @@ let universe_has_max env u = let rec head_matches env t1 t2 : match_result = let t1 = U.unmeta t1 in let t2 = U.unmeta t2 in - if Env.debug env <| Options.Other "RelDelta" then ( + if !dbg_RelDelta then ( BU.print2 "head_matches %s %s\n" (show t1) (show t2); BU.print2 " %s -- %s\n" (Print.tag_of_term t1) (Print.tag_of_term t2); () @@ -1325,7 +1340,7 @@ let head_matches_delta env (logical:bool) smt_ok t1 t2 : (match_result & option in let maybe_inline t = let head = U.head_of (unrefine env t) in - if Env.debug env <| Options.Other "RelDelta" then + if !dbg_RelDelta then BU.print2 "Head of %s is %s\n" (show t) (show head); match (U.un_uinst head).n with | Tm_fvar fv -> @@ -1337,7 +1352,7 @@ let head_matches_delta env (logical:bool) smt_ok t1 t2 : (match_result & option fv.fv_name.v with | None -> - if Env.debug env <| Options.Other "RelDelta" then + if !dbg_RelDelta then BU.print1 "No definition found for %s\n" (show head); None | Some _ -> @@ -1361,7 +1376,7 @@ let head_matches_delta env (logical:bool) smt_ok t1 t2 : (match_result & option let t' = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.1" steps env t in if U.eq_tm t t' = U.Equal //if we didn't inline anything then None - else let _ = if Env.debug env <| Options.Other "RelDelta" + else let _ = if !dbg_RelDelta then BU.print2 "Inlined %s to %s\n" (show t) (show t') in @@ -1386,7 +1401,7 @@ let head_matches_delta env (logical:bool) smt_ok t1 t2 : (match_result & option let rec aux retry n_delta t1 t2 = let r = head_matches env t1 t2 in - if Env.debug env <| Options.Other "RelDelta" then + if !dbg_RelDelta then BU.print3 "head_matches (%s, %s) = %s\n" (show t1) (show t2) @@ -1442,7 +1457,7 @@ let head_matches_delta env (logical:bool) smt_ok t1 t2 : (match_result & option | _ -> success n_delta r t1 t2 in let r = aux true 0 t1 t2 in - if Env.debug env <| Options.Other "RelDelta" then + if !dbg_RelDelta then BU.print3 "head_matches_delta (%s, %s) = %s\n" (show t1) (show t2) (show r); r @@ -1772,7 +1787,7 @@ let should_defer_flex_to_user_tac (wl:worklist) (f:flex_t) = let (Flex (_, u, _)) = f in let b = DeferredImplicits.should_defer_uvar_to_user_tac wl.tcenv u in - if debug wl <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then BU.print3 "Rel.should_defer_flex_to_user_tac for %s returning %s (env.enable_defer_to_tac: %s)\n" (Print.ctx_uvar_to_string_no_reason u) (string_of_bool b) (string_of_bool wl.tcenv.enable_defer_to_tac); @@ -1842,7 +1857,7 @@ let run_meta_arg_tac (env:env_t) (ctx_u:ctx_uvar) : term = match ctx_u.ctx_uvar_meta with | Some (Ctx_uvar_meta_tac tau) -> let env = { env with gamma = ctx_u.ctx_uvar_gamma } in - if Env.debug env (Options.Other "Tac") then + if !dbg_Tac then BU.print1 "Running tactic for meta-arg %s\n" (show ctx_u); Errors.with_ctx "Running tactic for meta-arg" (fun () -> env.synth_hook env (U.ctx_uvar_typ ctx_u) tau) @@ -1850,7 +1865,7 @@ let run_meta_arg_tac (env:env_t) (ctx_u:ctx_uvar) : term = failwith "run_meta_arg_tac must have been called with a uvar that has a meta tac" let simplify_vc full_norm_allowed env t = - if Env.debug env <| Options.Other "Simplification" then + if !dbg_Simplification then BU.print1 "Simplifying guard %s\n" (show t); let steps = [Env.Beta; Env.Eager_unfolding; @@ -1859,7 +1874,7 @@ let simplify_vc full_norm_allowed env t = Env.Exclude Env.Zeta] in let steps = if full_norm_allowed then steps else Env.NoFullNorm::steps in let t' = norm_with_steps "FStar.TypeChecker.Rel.simplify_vc" steps env t in - if Env.debug env <| Options.Other "Simplification" then + if !dbg_Simplification then BU.print1 "Simplified guard to %s\n" (show t'); t' @@ -1910,8 +1925,6 @@ let apply_substitutive_indexed_subcomp (env:Env.env) : typ & list prob & worklist = - let debug = debug wl <| Options.Other "LayeredEffectsApp" in - // // We will collect the substitutions in subst, // bs will be the remaining binders (that are not in subst yet) @@ -1979,7 +1992,7 @@ let apply_substitutive_indexed_subcomp (env:Env.env) List.fold_left (fun (ss, wl) b -> let [uv_t], g = Env.uvars_for_binders env [b] ss (fun b -> - if debug + if !dbg_LayeredEffectsApp then BU.format3 "implicit var for additional binder %s in subcomp %s at %s" (Print.binder_to_string b) subcomp_name @@ -2023,8 +2036,6 @@ let apply_ad_hoc_indexed_subcomp (env:Env.env) : typ & list prob & worklist = - let dbg = debug wl <| Options.Other "LayeredEffectsApp" in - let stronger_t_shape_error s = BU.format2 "Unexpected shape of stronger for %s, reason: %s" (Ident.string_of_lid ct2.effect_name) s in @@ -2043,7 +2054,7 @@ let apply_ad_hoc_indexed_subcomp (env:Env.env) Env.uvars_for_binders env rest_bs [NT (a_b.binder_bv, ct2.result_typ)] (fun b -> - if dbg + if !dbg_LayeredEffectsApp then BU.format3 "implicit for binder %s in subcomp %s at %s" (Print.binder_to_string b) subcomp_name @@ -2065,7 +2076,7 @@ let apply_ad_hoc_indexed_subcomp (env:Env.env) |> List.map (SS.subst substs) in List.fold_left2 (fun (ps, wl) f_sort_i c1_i -> - if debug wl <| Options.Other "LayeredEffectsEqns" + if !dbg_LayeredEffectsApp then BU.print3 "Layered Effects (%s) %s = %s\n" subcomp_name (show f_sort_i) (show c1_i); let p, wl = sub_prob wl f_sort_i EQ c1_i "indices of c1" in @@ -2082,7 +2093,7 @@ let apply_ad_hoc_indexed_subcomp (env:Env.env) r1 (stronger_t_shape_error "subcomp return type is not a repr") in List.fold_left2 (fun (ps, wl) g_sort_i c2_i -> - if debug wl <| Options.Other "LayeredEffectsEqns" + if !dbg_LayeredEffectsApp then BU.print3 "Layered Effects (%s) %s = %s\n" subcomp_name (show g_sort_i) (show c2_i); let p, wl = sub_prob wl g_sort_i EQ c2_i "indices of c2" in @@ -2140,9 +2151,9 @@ type reveal_hide_t = (******************************************************************************************************) let rec solve (probs :worklist) : solution = // printfn "Solving TODO:\n%s;;" (List.map prob_to_string probs.attempting |> String.concat "\n\t"); - if debug probs <| Options.Other "Rel" + if !dbg_Rel then BU.print1 "solve:\n\t%s\n" (wl_to_string probs); - if debug probs <| Options.Other "ImplicitTrace" then + if !dbg_ImplicitTrace then BU.print1 "solve: wl_implicits = %s\n" (Common.implicits_to_string probs.wl_implicits); @@ -2230,7 +2241,7 @@ and solve_maybe_uinsts (orig:prob) (t1:term) (t2:term) (wl:worklist) : univ_eq_s and giveup_or_defer (orig:prob) (wl:worklist) (reason:deferred_reason) (msg:lstring) : solution = if wl.defer_ok = DeferAny then begin - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print2 "\n\t\tDeferring %s\n\t\tBecause %s\n" (prob_to_string wl.tcenv orig) (Thunk.force msg); solve (defer reason msg orig wl) end @@ -2239,14 +2250,14 @@ and giveup_or_defer (orig:prob) (wl:worklist) (reason:deferred_reason) (msg:lstr and giveup_or_defer_flex_flex (orig:prob) (wl:worklist) (reason:deferred_reason) (msg:lstring) : solution = if wl.defer_ok <> NoDefer then begin - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print2 "\n\t\tDeferring %s\n\t\tBecause %s\n" (prob_to_string wl.tcenv orig) (Thunk.force msg); solve (defer reason msg orig wl) end else giveup wl msg orig and defer_to_user_tac (orig:prob) reason (wl:worklist) : solution = - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print1 "\n\t\tDeferring %s to a tactic\n" (prob_to_string wl.tcenv orig); let wl = solve_prob orig None [] wl in let wl = {wl with wl_deferred_to_tac=(wl.ctr, @@ -2305,7 +2316,7 @@ and solve_rigid_flex_or_flex_rigid_subtyping TProb p, wl in let pairwise t1 t2 wl = - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "[meet/join]: pairwise: %s and %s\n" (show t1) (show t2); let mr, ts = head_matches_delta (p_env wl (TProb tp)) tp.logical wl.smt_ok t1 t2 in match mr with @@ -2418,7 +2429,7 @@ and solve_rigid_flex_or_flex_rigid_subtyping (t, [p], wl) in let t1, ps, wl = combine t1 t2 wl in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print1 "pairwise fallback2 succeeded: %s" (show t1); t1, ps, wl @@ -2450,7 +2461,7 @@ and solve_rigid_flex_or_flex_rigid_subtyping match quasi_pattern wl.tcenv flex with | None -> giveup_lit wl "flex-arrow subtyping, not a quasi pattern" (TProb tp) | Some (flex_bs, flex_t) -> - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print1 "Trying to solve by imitating arrow:%s\n" (string_of_int tp.pid); imitate_arrow (TProb tp) wl flex flex_bs flex_t tp.relation this_rigid end @@ -2458,7 +2469,7 @@ and solve_rigid_flex_or_flex_rigid_subtyping solve (attempt [TProb ({tp with relation=EQ})] wl) | _ -> - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print1 "Trying to solve by meeting refinements:%s\n" (string_of_int tp.pid); let u, _args = U.head_and_args this_flex in let env = p_env wl (TProb tp) in @@ -2534,7 +2545,7 @@ and solve_rigid_flex_or_flex_rigid_subtyping (if flip then "joining refinements" else "meeting refinements") in def_check_prob "meet_or_join2" (TProb eq_prob); - let _ = if debug wl <| Options.Other "Rel" + let _ = if !dbg_Rel then let wl' = {wl with attempting=TProb eq_prob::sub_probs} in BU.print1 "After meet/join refinements: %s\n" (wl_to_string wl') in @@ -2557,7 +2568,7 @@ and solve_rigid_flex_or_flex_rigid_subtyping solve wl | Failed (p, msg) -> - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print1 "meet/join attempted and failed to solve problems:\n%s\n" (List.map (prob_to_string env) (TProb eq_prob::sub_probs) |> String.concat "\n"); (match rank, base_and_refinement env bound_typ with @@ -2670,7 +2681,7 @@ and imitate_arrow (orig:prob) (wl:worklist) and solve_binders (bs1:binders) (bs2:binders) (orig:prob) (wl:worklist) (rhs:worklist -> binders -> list subst_elt -> (prob * worklist)) : solution = - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print3 "solve_binders\n\t%s\n%s\n\t%s\n" (Print.binders_to_string ", " bs1) (rel_to_string (p_rel orig)) @@ -2709,7 +2720,7 @@ and solve_binders (bs1:binders) (bs2:binders) (orig:prob) (wl:worklist) match xs, ys with | [], [] -> let rhs_prob, wl = rhs wl scope subst in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print1 "rhs_prob = %s\n" (prob_to_string (p_env wl rhs_prob) rhs_prob); let formula = p_guard rhs_prob in Inl ([rhs_prob], formula), wl @@ -2730,7 +2741,7 @@ and solve_binders (bs1:binders) (bs2:binders) (orig:prob) (wl:worklist) let phi = U.mk_conj (p_guard prob) (close_forall (p_env wl prob) [{x with binder_bv=hd1}] phi) in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Formula is %s\n\thd1=%s\n" (show phi) (Print.bv_to_string hd1); Inl (prob::sub_probs, phi), wl @@ -2812,7 +2823,7 @@ and solve_t (problem:tprob) (wl:worklist) : solution = and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) : solution = - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print_string "solve_t_flex_rigid_eq\n"; if should_defer_flex_to_user_tac wl lhs @@ -2935,7 +2946,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) let try_quasi_pattern (orig:prob) (env:Env.env) (wl:worklist) (lhs:flex_t) (rhs:term) : either string (list uvi) * worklist = - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print_string "try_quasi_pattern\n"; match quasi_pattern env lhs with | None -> @@ -2996,7 +3007,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) (lhs:flex_t) (bs_lhs:binders) (t_res_lhs:term) (rhs:term) : solution = - // if debug wl <| Options.Other "Rel" + // if !dbg_Rel // then BU.print4 "imitate_app 1:\n\tlhs=%s\n\tbs_lhs=%s\n\tt_res_lhs=%s\n\trhs=%s\n" // (flex_t_to_string lhs) // (Print.binders_to_string ", " bs_lhs) @@ -3005,7 +3016,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) let rhs_hd, args = U.head_and_args rhs in let args_rhs, last_arg_rhs = BU.prefix args in let rhs' = S.mk_Tm_app rhs_hd args_rhs rhs.pos in - // if debug wl <| Options.Other "Rel" + // if !dbg_Rel // then BU.print2 "imitate_app 2:\n\trhs'=%s\n\tlast_arg_rhs=%s\n" // (show rhs') // (show [last_arg_rhs]); @@ -3027,7 +3038,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) let _, lhs'_last_arg, wl = copy_uvar u_lhs bs_lhs t_last_arg wl in lhs', lhs'_last_arg, wl in - // if debug wl <| Options.Other "Rel" + // if !dbg_Rel // then BU.print2 "imitate_app 3:\n\tlhs'=%s\n\tlast_arg_lhs=%s\n" // (show lhs') // (show lhs'_last_arg); @@ -3056,7 +3067,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) let imitate (orig:prob) (env:Env.env) (wl:worklist) (lhs:flex_t) (rhs:term) : solution = - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print_string "imitate\n"; let is_app rhs = let _, args = U.head_and_args rhs in @@ -3101,7 +3112,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) *) let try_first_order orig env wl lhs rhs = let inapplicable msg lstring_opt = - if debug wl <| Options.Other "Rel" + if !dbg_Rel then ( let extra_msg = match lstring_opt with @@ -3112,7 +3123,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) ); Inl "first_order doesn't apply" in - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print2 "try_first_order\n\tlhs=%s\n\trhs=%s\n" (flex_t_to_string lhs) (show rhs); @@ -3175,7 +3186,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) // solve_sub_probs_if_head_types_equal uvars_head wl else ( - if debug wl (Options.Other "Rel") + if !dbg_Rel then BU.print2 "first-order: head type mismatch:\n\tlhs=%s\n\trhs=%s\n" (show (U.ctx_uvar_typ ctx_uv)) (show t_head); @@ -3211,12 +3222,12 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) let env = p_env wl orig in match pat_vars env ctx_uv.ctx_uvar_binders args_lhs with | Some lhs_binders -> //Pattern - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print_string "it's a pattern\n"; let rhs = sn env rhs in let fvs1 = binders_as_bv_set (ctx_uv.ctx_uvar_binders @ lhs_binders) in let fvs2 = Free.names rhs in - //if debug wl <| Options.Other "Rel" then + //if !dbg_Rel then // BU.print4 "lhs \t= %s\n\ // FV(lhs) \t= %s\n\ // rhs \t= %s\n\ @@ -3280,7 +3291,7 @@ and solve_t_flex_flex env orig wl (lhs:flex_t) (rhs:flex_t) : solution = let run_meta_arg_tac_and_try_again (flex:flex_t) = let uv = flex_uvar flex in let t = run_meta_arg_tac env uv in - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print2 "solve_t_flex_flex: solving meta arg uvar %s with %s\n" (show uv) (show t); set_uvar env uv None t; solve (attempt [orig] wl) in @@ -3346,7 +3357,7 @@ and solve_t_flex_flex env orig wl (lhs:flex_t) (rhs:flex_t) : solution = (show wl.defer_ok))) else begin // let _ = - // if debug wl <| Options.Other "Rel" + // if !dbg_Rel // then BU.print1 "flex-flex quasi: %s\n" // (BU.stack_dump()) // in @@ -3367,7 +3378,7 @@ and solve_t_flex_flex env orig wl (lhs:flex_t) (rhs:flex_t) : solution = in let w_app = S.mk_Tm_app w (List.map (fun ({binder_bv=z}) -> S.as_arg (S.bv_to_name z)) zs) w.pos in let _ = - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print "flex-flex quasi:\n\t\ lhs=%s\n\t\ rhs=%s\n\t\ @@ -3404,7 +3415,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = let rigid_heads_match (need_unif:bool) (torig:tprob) (wl:worklist) (t1:term) (t2:term) : solution = let orig = TProb torig in let env = p_env wl orig in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print5 "Heads %s: %s (%s) and %s (%s)\n" (if need_unif then "need unification" else "match") (show t1) (Print.tag_of_term t1) @@ -3468,7 +3479,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = argp ([], wl) in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Adding subproblems for arguments (smtok=%s): %s" (string_of_bool wl.smt_ok) @@ -3495,7 +3506,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = solve (attempt subprobs wl)) in let unfold_and_retry d wl (prob, reason) = - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Failed to solve %s because a sub-problem is not solvable without SMT because %s" (prob_to_string env orig) (Thunk.force reason); @@ -3509,7 +3520,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = begin match U.eq_tm head1' head1, U.eq_tm head2' head2 with | U.Equal, U.Equal -> //unfolding didn't make progress - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print4 "Unfolding didn't make progress ... got %s ~> %s;\nand %s ~> %s\n" (show t1) @@ -3519,7 +3530,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = solve_sub_probs env wl //fallback to trying to solve with SMT on | _ -> let torig' = {torig with lhs=t1'; rhs=t2'} in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print1 "Unfolded and now trying %s\n" (prob_to_string env (TProb torig')); solve_t torig' wl @@ -3612,7 +3623,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = |> fst |> N.normalize_refinement N.whnf_steps env |> U.unrefine in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print1 "Match heuristic, typechecking the pattern term: %s {\n\n" (show pat_term); let pat_term, pat_term_t, g_pat_term = @@ -3620,7 +3631,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = (Env.set_expected_typ env scrutinee_t) pat_term must_tot in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "} Match heuristic, typechecked pattern term to %s and type %s\n" (show pat_term) (show pat_term_t); @@ -3668,7 +3679,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = match t1t2_opt with | None -> Inr None | Some (t1, t2) -> - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Trying match heuristic for %s vs. %s\n" (show t1) (show t2); @@ -3677,16 +3688,16 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = | (s, t), (_, {n=Tm_match {scrutinee; brs=branches}}) -> if not (is_flex scrutinee) then begin - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print1 "match head %s is not a flex term\n" (show scrutinee); Inr None end else if wl.defer_ok = DeferAny - then (if debug wl <| Options.Other "Rel" + then (if !dbg_Rel then BU.print_string "Deferring ... \n"; Inl "defer") else begin - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Heuristic applicable with scrutinee %s and other side = %s\n" (show scrutinee) (show t); @@ -3712,7 +3723,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = begin match head_matching_branch with | None -> - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print_string "No head_matching branch\n"; let try_branches = match BU.prefix_until (fun b -> not (pat_discriminates b)) branches with @@ -3725,7 +3736,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = | Some b -> let (p, _, e) = SS.open_branch b in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Found head matching branch %s -> %s\n" (Print.pat_to_string p) (show e); @@ -3734,7 +3745,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = end end | _ -> - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Heuristic not applicable: tag lhs=%s, rhs=%s\n" (Print.tag_of_term t1) (Print.tag_of_term t2); Inr None @@ -3745,7 +3756,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = (head1:term) (head2:term) (t1:term) (t2:term) : solution = let orig = TProb torig in - if debug wl <| Options.Other "RelDelta" then + if !dbg_RelDelta then BU.print4 "rigid_rigid_delta of %s-%s (%s, %s)\n" (Print.tag_of_term t1) (Print.tag_of_term t2) @@ -3881,7 +3892,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = def_check_scoped (p_loc orig) "ref.t1" (List.map (fun b -> b.binder_bv) (p_scope orig)) t1; def_check_scoped (p_loc orig) "ref.t2" (List.map (fun b -> b.binder_bv) (p_scope orig)) t2; let _ = - if debug wl (Options.Other "Rel") + if !dbg_Rel then BU.print4 "Attempting %s (%s vs %s); rel = (%s)\n" (string_of_int problem.pid) (Print.tag_of_term t1 ^ "::" ^ show t1) (Print.tag_of_term t2 ^ "::" ^ show t2) @@ -3970,7 +3981,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = let x1, phi1 = as_refinement false env t1 in let x2, phi2 = as_refinement false env t2 in (* / hack *) - if debug wl (Options.Other "Rel") then begin + if !dbg_Rel then begin BU.print3 "ref1 = (%s):(%s){%s}\n" (show x1) (show x1.sort) (show phi1); @@ -4164,7 +4175,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = (* Branch body *) // GM: Could use problem.relation here instead of EQ? let prob, wl = mk_t_problem wl scope orig e1 EQ e2 None "branch body" in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Created problem for branches %s with scope %s\n" (prob_to_string' wl prob) (Print.binders_to_string ", " scope); @@ -4212,7 +4223,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = let head1 = U.head_and_args t1 |> fst in let head2 = U.head_and_args t2 |> fst in let _ = - if debug wl (Options.Other "Rel") + if !dbg_Rel then BU.print ">> (%s) (smtok=%s)\n>>> head1 = %s [interpreted=%s; no_free_uvars=%s]\n>>> head2 = %s [interpreted=%s; no_free_uvars=%s]\n" [(show problem.pid); (show wl.smt_ok); @@ -4309,7 +4320,7 @@ and solve_c (problem:problem comp) (wl:worklist) : solution = fun wl t1 rel t2 reason -> mk_t_problem wl [] orig t1 rel t2 None reason in let solve_eq c1_comp c2_comp g_lift = - let _ = if debug wl <| Options.Other "EQ" + let _ = if !dbg_EQ then BU.print2 "solve_c is using an equality constraint (%s vs %s)\n" (show (mk_Comp c1_comp)) (show (mk_Comp c2_comp)) in @@ -4370,7 +4381,7 @@ and solve_c (problem:problem comp) (wl:worklist) : solution = // primitive effects. let solve_layered_sub c1 c2 = - if debug wl <| Options.Other "LayeredEffectsApp" then + if !dbg_LayeredEffectsApp then BU.print2 "solve_layered_sub c1: %s and c2: %s {\n" (c1 |> S.mk_Comp |> show) (c2 |> S.mk_Comp |> show); @@ -4478,7 +4489,7 @@ and solve_c (problem:problem comp) (wl:worklist) : solution = List.fold_right2 (fun (a1, _) (a2, _) (is_sub_probs, wl) -> if is_uvar a1 then begin - if debug wl <| Options.Other "LayeredEffectsEqns" then + if !dbg_LayeredEffectsEqns then BU.print2 "Layered Effects teq (rel c1 index uvar) %s = %s\n" (show a1) (show a2); let p, wl = sub_prob wl a1 EQ a2 "l.h.s. effect index uvar" in @@ -4511,7 +4522,7 @@ and solve_c (problem:problem comp) (wl:worklist) : solution = U.mk_conj guard fml in let wl = solve_prob orig (Some guard) [] wl in - if debug wl <| Options.Other "LayeredEffectsApp" + if !dbg_LayeredEffectsApp then BU.print_string "}\n"; solve (attempt sub_probs wl) in @@ -4580,7 +4591,7 @@ and solve_c (problem:problem comp) (wl:worklist) : solution = U.t_true else let wpc1_2 = lift_c1 () |> (fun ct -> List.hd ct.effect_args) in if is_null_wp_2 - then let _ = if debug wl <| Options.Other "Rel" + then let _ = if !dbg_Rel then BU.print_string "Using trivial wp ... \n" in let c1_univ = env.universe_of env c1.result_typ in let trivial = @@ -4593,7 +4604,7 @@ and solve_c (problem:problem comp) (wl:worklist) : solution = let stronger = c2_decl |> U.get_stronger_vc_combinator |> fst in mk (Tm_app {hd=inst_effect_fun_with [c2_univ] env c2_decl stronger; args=[as_arg c2.result_typ; as_arg wpc2; wpc1_2]}) r in - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print1 "WP guard (simplifed) is (%s)\n" (show (N.normalize [Env.Iota; Env.Eager_unfolding; Env.Primops; Env.Simplify] env g)); let base_prob, wl = sub_prob wl c1.result_typ problem.relation c2.result_typ "result type" in let wl = solve_prob orig (Some <| U.mk_conj (p_guard base_prob) g) [] wl in @@ -4602,7 +4613,7 @@ and solve_c (problem:problem comp) (wl:worklist) : solution = if BU.physical_equality c1 c2 then solve (solve_prob orig None [] wl) - else let _ = if debug wl <| Options.Other "Rel" + else let _ = if !dbg_Rel then BU.print3 "solve_c %s %s %s\n" (show c1) (rel_to_string problem.relation) @@ -4660,7 +4671,7 @@ and solve_c (problem:problem comp) (wl:worklist) : solution = else begin let c1 = Env.unfold_effect_abbrev env c1 in let c2 = Env.unfold_effect_abbrev env c2 in - if debug wl <| Options.Other "Rel" then BU.print2 "solve_c for %s and %s\n" (string_of_lid c1.effect_name) (string_of_lid c2.effect_name); + if !dbg_Rel then BU.print2 "solve_c for %s and %s\n" (string_of_lid c1.effect_name) (string_of_lid c2.effect_name); if Env.is_layered_effect env c2.effect_name then solve_layered_sub c1 c2 else match Env.monad_leq env c1.effect_name c2.effect_name with @@ -4700,8 +4711,8 @@ let guard_to_string (env:env) g = let form = match g.guard_f with | Trivial -> "trivial" | NonTrivial f -> - if Env.debug env <| Options.Other "Rel" - || Env.debug env <| Options.Extreme + if !dbg_Rel + || Debug.extreme () || Options.print_implicits () then N.term_to_string env f else "non-trivial" in @@ -4712,8 +4723,8 @@ let guard_to_string (env:env) g = (ineqs_to_string g.univ_ineqs) imps let new_t_problem wl env lhs rel rhs elt loc = - let reason = if debug wl <| Options.Other "ExplainRel" - || debug wl <| Options.Other "Rel" + let reason = if !dbg_ExplainRel + || !dbg_Rel then BU.format3 "Top-level:\n%s\n\t%s\n%s" (N.term_to_string env lhs) (rel_to_string rel) (N.term_to_string env rhs) @@ -4731,22 +4742,22 @@ let solve_and_commit wl err : option (deferred * deferred * implicits) = let tx = UF.new_transaction () in - if debug wl <| Options.Other "RelBench" then + if !dbg_RelBench then BU.print1 "solving problems %s {\n" (FStar.Common.string_of_list (fun p -> string_of_int (p_pid p)) wl.attempting); let (sol, ms) = BU.record_time (fun () -> solve wl) in - if debug wl <| Options.Other "RelBench" then + if !dbg_RelBench then BU.print1 "} solved in %s ms\n" (string_of_int ms); match sol with | Success (deferred, defer_to_tac, implicits) -> let ((), ms) = BU.record_time (fun () -> UF.commit tx) in - if debug wl <| Options.Other "RelBench" then + if !dbg_RelBench then BU.print1 "committed in %s ms\n" (string_of_int ms); Some (deferred, defer_to_tac, implicits) | Failed (d,s) -> - if debug wl <| Options.Other "ExplainRel" - || debug wl <| Options.Other "Rel" + if !dbg_ExplainRel + || !dbg_Rel then BU.print_string <| explain wl d s; let result = err (d,s) in UF.rollback tx; @@ -4771,11 +4782,11 @@ let try_teq smt_ok env t1 t2 : option guard_t = let smt_ok = smt_ok && not (Options.ml_ish ()) in Profiling.profile (fun () -> - if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "RelTop" then + if !dbg_RelTop then BU.print3 "try_teq of %s and %s in %s {\n" (show t1) (show t2) (show env.gamma); let prob, wl = new_t_problem (empty_worklist env) env t1 EQ t2 None (Env.get_range env) in let g = with_guard env prob <| solve_and_commit (singleton wl prob smt_ok) (fun _ -> None) in - if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "RelTop" then + if !dbg_RelTop then BU.print1 "} res = %s\n" (FStar.Common.string_of_option (guard_to_string env) g); g) (Some (Ident.string_of_lid (Env.current_module env))) @@ -4790,7 +4801,7 @@ let teq env t1 t2 : guard_t = (Err.basic_type_error env None t2 t1); trivial_guard | Some g -> - if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "RelTop" then + if !dbg_Rel || !dbg_RelTop then BU.print3 "teq of %s and %s succeeded with guard %s\n" (show t1) (show t2) (guard_to_string env g); g @@ -4802,11 +4813,11 @@ let teq env t1 t2 : guard_t = * But that may change the existing VCs shape a bit *) let get_teq_predicate env t1 t2 = - if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "RelTop" then + if !dbg_Rel || !dbg_RelTop then BU.print2 "get_teq_predicate of %s and %s {\n" (show t1) (show t2); let prob, x, wl = new_t_prob (empty_worklist env) env t1 EQ t2 in let g = with_guard env prob <| solve_and_commit (singleton wl prob true) (fun _ -> None) in - if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "RelTop" then + if !dbg_Rel || !dbg_RelTop then BU.print1 "} res teq predicate = %s\n" (FStar.Common.string_of_option (guard_to_string env) g); match g with @@ -4819,7 +4830,7 @@ let subtype_fail env e t1 t2 = let sub_or_eq_comp env (use_eq:bool) c1 c2 = Profiling.profile (fun () -> let rel = if use_eq then EQ else SUB in - if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "RelTop" then + if !dbg_Rel || !dbg_RelTop then BU.print3 "sub_comp of %s --and-- %s --with-- %s\n" (show c1) (show c2) (if rel = EQ then "EQ" else "SUB"); let prob, wl = new_problem (empty_worklist env) env c1 rel c2 None (Env.get_range env) "sub_comp" in let wl = { wl with repr_subcomp_allowed = true } in @@ -4828,7 +4839,7 @@ let sub_or_eq_comp env (use_eq:bool) c1 c2 = let (r, ms) = BU.record_time (fun () -> with_guard env prob <| solve_and_commit (singleton wl prob true) (fun _ -> None)) in - if Env.debug env <| Options.Other "RelBench" then + if !dbg_RelBench then BU.print4 "sub_comp of %s --and-- %s --with-- %s --- solved in %s ms\n" (show c1) (show c2) (if rel = EQ then "EQ" else "SUB") (string_of_int ms); r) (Some (Ident.string_of_lid (Env.current_module env))) @@ -4911,11 +4922,11 @@ let solve_universe_inequalities' tx env (variables, ineqs) : unit = if ineqs |> BU.for_all (fun (u, v) -> if check_ineq (u, v) then true - else (if Env.debug env <| Options.Other "GenUniverses" + else (if !dbg_GenUniverses then BU.print2 "%s discharge_guard' None env g false let subtype_nosmt env t1 t2 = - if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "RelTop" + if !dbg_Rel || !dbg_RelTop then BU.print2 "try_subtype_no_smt of %s and %s\n" (N.term_to_string env t1) (N.term_to_string env t2); let prob, x, wl = new_t_prob (empty_worklist env) env t1 SUB t2 in let g = with_guard env prob <| solve_and_commit (singleton wl prob false) (fun _ -> None) in @@ -5181,15 +5184,13 @@ let subtype_nosmt env t1 t2 = /////////////////////////////////////////////////////////////////// let check_subtyping env t1 t2 = Profiling.profile (fun () -> - if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "RelTop" - + if !dbg_Rel || !dbg_RelTop then BU.print2 "check_subtyping of %s and %s\n" (N.term_to_string env t1) (N.term_to_string env t2); let prob, x, wl = new_t_prob (empty_worklist env) env t1 SUB t2 in let env_x = Env.push_bv env x in let smt_ok = not (Options.ml_ish ()) in let g = with_guard env_x prob <| solve_and_commit (singleton wl prob smt_ok) (fun _ -> None) in - if (Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "RelTop") - && BU.is_some g + if (!dbg_Rel || !dbg_RelTop) && BU.is_some g then BU.print3 "check_subtyping succeeded: %s <: %s\n\tguard is %s\n" (N.term_to_string env_x t1) (N.term_to_string env_x t2) @@ -5296,7 +5297,7 @@ let check_implicit_solution_and_discharge_guard env let uvar_ty = U.ctx_uvar_typ imp_uvar in let uvar_should_check = U.ctx_uvar_should_check imp_uvar in - if Env.debug env <| Options.Other "Rel" + if !dbg_Rel then BU.print5 "Checking uvar %s resolved to %s at type %s, introduce for %s at %s\n" (Print.uvar_to_string imp_uvar.ctx_uvar_head) (show imp_tm) @@ -5525,7 +5526,7 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) | hd::tl -> let { imp_reason = reason; imp_tm = tm; imp_uvar = ctx_u; imp_range = r } = hd in let { uvar_decoration_typ; uvar_decoration_should_check } = UF.find_decoration ctx_u.ctx_uvar_head in - if Env.debug env <| Options.Other "Rel" then + if !dbg_Rel then BU.print4 "resolve_implicits' loop, imp_tm=%s and ctx_u=%s, is_tac=%s, should_check=%s\n" (show tm) (show ctx_u) (show is_tac) (show uvar_decoration_should_check); begin match () with @@ -5540,7 +5541,7 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) if defer_open_metas && is_open then ( (* If the result type or env for this meta arg has a free uvar, delay it. Some other meta arg being solved may instantiate the uvar. See #3130. *) - if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "Imps" then + if !dbg_Rel || !dbg_Imps then BU.print1 "Deferring implicit due to open ctx/typ %s\n" (show ctx_u); until_fixpoint ((hd, Implicit_unresolved)::out, changed, defer_open_metas) tl ) else if is_open && not (meta_tac_allowed_for_open_problem tac) @@ -5622,12 +5623,12 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) until_fixpoint ([], false, true) implicits let resolve_implicits env g = - if Env.debug env <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then BU.print1 "//////////////////////////ResolveImplicitsHook: resolve_implicits begin////////////\n\ guard = %s {\n" (guard_to_string env g); let tagged_implicits = resolve_implicits' env false false g.implicits in - if Env.debug env <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then BU.print_string "//////////////////////////ResolveImplicitsHook: resolve_implicits end////////////\n\ }\n"; {g with implicits = List.map fst tagged_implicits} @@ -5639,7 +5640,7 @@ let resolve_generalization_implicits env g = let resolve_implicits_tac env g = resolve_implicits' env true false g.implicits let force_trivial_guard env g = - if Env.debug env <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then BU.print1 "//////////////////////////ResolveImplicitsHook: force_trivial_guard////////////\n\ guard = %s\n" (guard_to_string env g); @@ -5676,7 +5677,7 @@ let teq_nosmt_force (env:env) (t1:typ) (t2:typ) :bool = true let layered_effect_teq env (t1:term) (t2:term) (reason:option string) : guard_t = - if Env.debug env <| Options.Other "LayeredEffectsEqns" + if !dbg_LayeredEffectsEqns then BU.print3 "Layered Effect (%s) %s = %s\n" (if reason |> is_none then "_" else reason |> must) (show t1) (show t2); diff --git a/src/typechecker/FStar.TypeChecker.Tc.fst b/src/typechecker/FStar.TypeChecker.Tc.fst index a8058c5269e..5e1c955edb1 100644 --- a/src/typechecker/FStar.TypeChecker.Tc.fst +++ b/src/typechecker/FStar.TypeChecker.Tc.fst @@ -53,6 +53,12 @@ module EMB = FStar.Syntax.Embeddings module ToSyntax = FStar.ToSyntax.ToSyntax module O = FStar.Options +let dbg_TwoPhases = Debug.get_toggle "TwoPhases" +let dbg_IdInfoOn = Debug.get_toggle "IdInfoOn" +let dbg_Normalize = Debug.get_toggle "Normalize" +let dbg_UF = Debug.get_toggle "UF" +let dbg_LogTypes = Debug.get_toggle "LogTypes" + let sigelt_typ (se:sigelt) : option typ = match se.sigel with | Sig_inductive_typ {t} @@ -129,7 +135,7 @@ let tc_decl_attributes env se = {se with sigattrs = blacklisted_attrs @ other_attrs } let tc_inductive' env ses quals attrs lids = - if Env.debug env Options.Low then + if Debug.low () then BU.print1 ">>>>>>>>>>>>>>tc_inductive %s\n" (FStar.Common.string_of_list Print.sigelt_to_string ses); let ses = List.map (tc_decl_attributes env) ses in @@ -382,7 +388,7 @@ let tc_sig_let env r se lbs lids : list sigelt * list sigelt * Env.env = let preprocess_lb (tau:term) (lb:letbinding) : letbinding = let lbdef = Env.preprocess env tau lb.lbdef in - if Env.debug env <| Options.Other "TwoPhases" then + if Debug.medium () || !dbg_TwoPhases then BU.print1 "lb preprocessed into: %s\n" (Print.term_to_string lbdef); { lb with lbdef = lbdef } in @@ -429,13 +435,13 @@ let tc_sig_let env r se lbs lids : list sigelt * list sigelt * Env.env = "FStar.TypeChecker.Tc.tc_sig_let-tc-phase1" in - if Env.debug env <| Options.Other "TwoPhases" then + if Debug.medium () || !dbg_TwoPhases then BU.print1 "Let binding after phase 1, before removing uvars: %s\n" (Print.term_to_string e); let e = N.remove_uvar_solutions env' e |> drop_lbtyp in - if Env.debug env <| Options.Other "TwoPhases" then + if Debug.medium () || !dbg_TwoPhases then BU.print1 "Let binding after phase 1, uvars removed: %s\n" (Print.term_to_string e); e) @@ -575,7 +581,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = * follow it. See #1956 for an example of what goes wrong if we * don't pop the context (spoiler: we prove false). *) - if Env.debug env Options.Low then + if Debug.low () then BU.print1 ">> Expecting errors: [%s]\n" (String.concat "; " <| List.map string_of_int expected_errors); let errs, _ = Errors.catch_errors (fun () -> @@ -583,7 +589,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = BU.must (!tc_decls_knot) env' ses)) in if Options.print_expected_failures () - || Env.debug env Options.Low then + || Debug.low () then begin BU.print_string ">> Got issues: [\n"; List.iter Errors.print_issue errs; @@ -627,7 +633,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = |> fst |> N.elim_uvars env |> U.ses_of_sigbundle in - if Env.debug env <| Options.Other "TwoPhases" + if Debug.medium () || !dbg_TwoPhases then BU.print1 "Inductive after phase 1: %s\n" (Print.sigelt_to_string ({ se with sigel = Sig_bundle {ses; lids} })); ses) else ses @@ -668,7 +674,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = TcEff.tc_eff_decl ({ env with phase1 = true; lax = true }) ne se.sigquals se.sigattrs |> (fun ne -> { se with sigel = Sig_new_effect ne }) |> N.elim_uvars env |> U.eff_decl_of_new_effect in - if Env.debug env <| Options.Other "TwoPhases" + if Debug.medium () || !dbg_TwoPhases then BU.print1 "Effect decl after phase 1: %s\n" (Print.sigelt_to_string ({ se with sigel = Sig_new_effect ne })); ne) @@ -723,7 +729,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = let uvs, t = if do_two_phases env then run_phase1 (fun _ -> let uvs, t = tc_declare_typ ({ env with phase1 = true; lax = true }) (uvs, t) se.sigrng in //|> N.normalize [Env.NoFullNorm; Env.Beta; Env.DoNotUnfoldPureLets] env in - if Env.debug env <| Options.Other "TwoPhases" then BU.print2 "Val declaration after phase 1: %s and uvs: %s\n" (Print.term_to_string t) (Print.univ_names_to_string uvs); + if Debug.medium () || !dbg_TwoPhases then BU.print2 "Val declaration after phase 1: %s and uvs: %s\n" (show t) (show uvs); uvs, t) else uvs, t in @@ -741,7 +747,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = let uvs, t = if do_two_phases env then run_phase1 (fun _ -> let uvs, t = tc_assume ({ env with phase1 = true; lax = true }) (uvs, t) se.sigrng in - if Env.debug env <| Options.Other "TwoPhases" then BU.print2 "Assume after phase 1: %s and uvs: %s\n" (Print.term_to_string t) (Print.univ_names_to_string uvs); + if Debug.medium () || !dbg_TwoPhases then BU.print2 "Assume after phase 1: %s and uvs: %s\n" (show t) (show uvs); uvs, t) else uvs, t in @@ -750,7 +756,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = [ { se with sigel = Sig_assume {lid; us=uvs; phi=t} }], [], env0 | Sig_splice {is_typed; lids; tac=t} -> - if Options.debug_any () then + if Debug.any () then BU.print3 "%s: Found splice of (%s) with is_typed: %s\n" (string_of_lid env.curmodule) (Print.term_to_string t) @@ -781,7 +787,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = let dsenv = List.fold_left DsEnv.push_sigelt_force env.dsenv ses in let env = { env with dsenv = dsenv } in - if Env.debug env Options.Low then + if Debug.low () then BU.print1 "Splice returned sigelts {\n%s\n}\n" (String.concat "\n" <| List.map Print.sigelt_to_string ses); @@ -813,7 +819,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = match se.sigel with | Sig_polymonadic_bind {tm=t; typ=ty} -> t, ty | _ -> failwith "Impossible! tc for Sig_polymonadic_bind must be a Sig_polymonadic_bind") in - if Env.debug env <| Options.Other "TwoPhases" + if Debug.medium () || !dbg_TwoPhases then BU.print1 "Polymonadic bind after phase 1: %s\n" (Print.sigelt_to_string ({ se with sigel = Sig_polymonadic_bind {m_lid=m; n_lid=n; @@ -847,7 +853,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = match se.sigel with | Sig_polymonadic_subcomp {tm=t; typ=ty} -> t, ty | _ -> failwith "Impossible! tc for Sig_polymonadic_subcomp must be a Sig_polymonadic_subcomp") in - if Env.debug env <| Options.Other "TwoPhases" + if Debug.medium () || !dbg_TwoPhases then BU.print1 "Polymonadic subcomp after phase 1: %s\n" (Print.sigelt_to_string ({ se with sigel = Sig_polymonadic_subcomp {m_lid=m; n_lid=n; @@ -870,12 +876,9 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = * during typechecking but not yet typechecked *) let tc_decl env se: list sigelt * list sigelt * Env.env = let env = set_hint_correlator env se in - if Options.debug_module (string_of_lid env.curmodule) then - BU.print1 "Processing %s\n" - (if Options.debug_at_level (string_of_lid env.curmodule) Options.High - then Print.sigelt_to_string se - else Print.sigelt_to_string_short se); - if Env.debug env Options.Low then + if Debug.any () then + BU.print1 "Processing %s\n" (Print.sigelt_to_string_short se); + if Debug.low () then BU.print1 ">>>>>>>>>>>>>>tc_decl %s\n" (show se); let result = if se.sigmeta.sigmeta_already_checked then @@ -899,7 +902,7 @@ let tc_decl env se: list sigelt * list sigelt * Env.env = (* adds the typechecked sigelt to the env, also performs any processing required in the env (such as reset options) *) (* AR: we now call this function when loading checked modules as well to be more consistent *) let add_sigelt_to_env (env:Env.env) (se:sigelt) (from_cache:bool) : Env.env = - if Env.debug env Options.Low + if Debug.low () then BU.print2 ">>>>>>>>>>>>>>Adding top-level decl to environment: %s (from_cache:%s)\n" (show se) (show from_cache); @@ -976,16 +979,16 @@ let tc_decls env ses = (* If emacs is peeking, and debugging is on, don't do anything, * otherwise the user will see a bunch of output from typechecking * definitions that were not yet advanced over. *) - if env.nosynth && Options.debug_any () + if env.nosynth && Debug.any () then (ses, env), [] else begin - if Env.debug env Options.Low + if Debug.low () then BU.print2 ">>>>>>>>>>>>>>Checking top-level %s decl %s\n" (Print.tag_of_sigelt se) (Print.sigelt_to_string se); if Options.ide_id_info_off() then Env.toggle_id_info env false; - if Env.debug env (Options.Other "IdInfoOn") then Env.toggle_id_info env true; + if !dbg_IdInfoOn then Env.toggle_id_info env true; let ses', ses_elaborated, env = Errors.with_ctx (BU.format2 "While typechecking the %stop-level declaration `%s`" @@ -995,11 +998,11 @@ let tc_decls env ses = in let ses' = ses' |> List.map (fun se -> - if Env.debug env (Options.Other "UF") + if !dbg_UF then BU.print1 "About to elim vars from %s\n" (Print.sigelt_to_string se); N.elim_uvars env se) in let ses_elaborated = ses_elaborated |> List.map (fun se -> - if Env.debug env (Options.Other "UF") + if !dbg_UF then BU.print1 "About to elim vars from (elaborated) %s\n" (Print.sigelt_to_string se); N.elim_uvars env se) in @@ -1037,10 +1040,8 @@ let tc_decls env ses = let env = ses' |> List.fold_left (fun env se -> add_sigelt_to_env env se false) env in UF.reset(); - if Options.log_types() || Env.debug env <| Options.Other "LogTypes" - then begin - BU.print1 "Checked: %s\n" (List.fold_left (fun s se -> s ^ Print.sigelt_to_string se ^ "\n") "" ses') - end; + if Options.log_types () || Debug.medium () || !dbg_LogTypes + then BU.print1 "Checked: %s\n" (show ses'); Profiling.profile (fun () -> List.iter (fun se -> env.solver.encode_sig env se) ses') @@ -1096,9 +1097,13 @@ let tc_partial_modul env modul = let verify = Options.should_verify (string_of_lid modul.name) in let action = if verify then "verifying" else "lax-checking" in let label = if modul.is_interface then "interface" else "implementation" in - if Options.debug_any () then + if Debug.any () then BU.print3 "Now %s %s of %s\n" action label (string_of_lid modul.name); + Debug.disable_all (); + if Options.should_check (string_of_lid modul.name) // || Options.debug_all_modules () + then Debug.enable_toggles (Options.debug_keys ()); + let name = BU.format2 "%s %s" (if modul.is_interface then "interface" else "module") (string_of_lid modul.name) in let env = {env with Env.is_iface=modul.is_interface; admit=not verify} in let env = Env.set_current_module env modul.name in @@ -1166,6 +1171,12 @@ let load_checked_module_sigelts (en:env) (m:modul) : env = let load_checked_module (en:env) (m:modul) :env = (* Another compression pass to make sure we are not loading a corrupt module. *) + + (* Reset debug flags *) + if Options.should_check (string_of_lid m.name) || Options.debug_all_modules () + then Debug.enable_toggles (Options.debug_keys ()) + else Debug.disable_all (); + let m = deep_compress_modul m in let env = load_checked_module_sigelts en m in //And then call finish_partial_modul, which is the normal workflow of tc_modul below @@ -1179,7 +1190,7 @@ let load_partial_checked_module (en:env) (m:modul) : env = load_checked_module_sigelts en m let check_module env m b = - if Options.debug_any() + if Debug.any() then BU.print2 "Checking %s: %s\n" (if m.is_interface then "i'face" else "module") (Print.lid_to_string m.name); if Options.dump_module (string_of_lid m.name) then BU.print1 "Module before type checking:\n%s\n" (Print.modul_to_string m); @@ -1190,7 +1201,7 @@ let check_module env m b = (* Debug information for level Normalize : normalizes all toplevel declarations an dump the current module *) if Options.dump_module (string_of_lid m.name) then BU.print1 "Module after type checking:\n%s\n" (Print.modul_to_string m); - if Options.dump_module (string_of_lid m.name) && Options.debug_at_level (string_of_lid m.name) (Options.Other "Normalize") + if Options.dump_module (string_of_lid m.name) && !dbg_Normalize then begin let normalize_toplevel_lets = fun se -> match se.sigel with | Sig_let {lbs=(b, lbs); lids=ids} -> diff --git a/src/typechecker/FStar.TypeChecker.TcEffect.fst b/src/typechecker/FStar.TypeChecker.TcEffect.fst index 39299526b31..4a8fff0f425 100644 --- a/src/typechecker/FStar.TypeChecker.TcEffect.fst +++ b/src/typechecker/FStar.TypeChecker.TcEffect.fst @@ -42,6 +42,9 @@ module Gen = FStar.TypeChecker.Generalize module BU = FStar.Compiler.Util open FStar.Class.Show +let dbg = Debug.get_toggle "ED" +let dbg_LayeredEffectsTc = Debug.get_toggle "LayeredEffectsTc" + let dmff_cps_and_elaborate env ed = (* This is only an elaboration rule not a typechecking one *) @@ -154,7 +157,7 @@ let bind_combinator_kind (env:env) : option (list indexed_effect_binder_kind) = let debug s = - if Env.debug env <| Options.Other "LayeredEffectsTc" + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print1 "%s\n" s in debug (BU.format1 @@ -496,7 +499,7 @@ let validate_indexed_effect_bind_shape (env:env) Ad_hoc_combinator | Some l -> Substitutive_combinator l in - if Env.debug env <| Options.Other "LayeredEffectsTc" + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print2 "Bind %s has %s kind\n" bind_name (Print.indexed_effect_combinator_kind_to_string kind); @@ -710,7 +713,7 @@ let validate_indexed_effect_subcomp_shape (env:env) let k = U.arrow (a_b::rest_bs@[f]) c in - if Env.debug env <| Options.Other "LayeredEffectsTc" then + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print1 "Expected type of subcomp before unification: %s\n" (Print.term_to_string k); @@ -746,7 +749,7 @@ let validate_indexed_effect_subcomp_shape (env:env) Ad_hoc_combinator | Some k -> k in - if Env.debug env <| Options.Other "LayeredEffectsTc" + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print2 "Subcomp %s has %s kind\n" subcomp_name (Print.indexed_effect_combinator_kind_to_string kind); @@ -957,7 +960,7 @@ let validate_indexed_effect_ite_shape (env:env) Ad_hoc_combinator | Some k -> k in - if Env.debug env <| Options.Other "LayeredEffectsTc" + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print2 "Ite %s has %s kind\n" ite_name (Print.indexed_effect_combinator_kind_to_string kind); @@ -1192,7 +1195,7 @@ let validate_indexed_effect_lift_shape (env:env) Ad_hoc_combinator | Some l -> Substitutive_combinator l in - if Env.debug env <| Options.Other "LayeredEffectsTc" + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print2 "Lift %s has %s kind\n" lift_name (Print.indexed_effect_combinator_kind_to_string kind); @@ -1206,7 +1209,7 @@ let validate_indexed_effect_lift_shape (env:env) *) let tc_layered_eff_decl env0 (ed : S.eff_decl) (quals : list qualifier) (attrs : list S.attribute) = Errors.with_ctx (BU.format1 "While checking layered effect definition `%s`" (string_of_lid ed.mname)) (fun () -> - if Env.debug env0 <| Options.Other "LayeredEffectsTc" then + if !dbg_LayeredEffectsTc then BU.print1 "Typechecking layered effect: \n\t%s\n" (Print.eff_decl_to_string false ed); //we don't support effect binders in layered effects yet @@ -1216,7 +1219,7 @@ Errors.with_ctx (BU.format1 "While checking layered effect definition `%s`" (str (range_of_lid ed.mname); let log_combinator s (us, t, ty) = - if Env.debug env0 <| Options.Other "LayeredEffectsTc" then + if !dbg_LayeredEffectsTc then BU.print4 "Typechecked %s:%s = %s:%s\n" (string_of_lid ed.mname) s (Print.tscheme_to_string (us, t)) (Print.tscheme_to_string (us, ty)) in @@ -1433,7 +1436,7 @@ Errors.with_ctx (BU.format1 "While checking layered effect definition `%s`" (str let stronger_us, stronger_t, stronger_ty = check_and_gen "stronger_repr" 1 stronger_repr in - if Env.debug env0 <| Options.Other "LayeredEffectsTc" then + if !dbg_LayeredEffectsTc then BU.print2 "stronger combinator typechecked with term: %s and type: %s\n" (Print.tscheme_to_string (stronger_us, stronger_t)) (Print.tscheme_to_string (stronger_us, stronger_ty)); @@ -1814,7 +1817,7 @@ Errors.with_ctx (BU.format1 "While checking layered effect definition `%s`" (str ({ Env.set_expected_typ env act_typ with instantiate_imp = false }) act.action_defn in - if Env.debug env <| Options.Other "LayeredEffectsTc" then + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print2 "Typechecked action definition: %s and action type: %s\n" (Print.term_to_string act_defn) (Print.term_to_string act_typ); @@ -1834,13 +1837,13 @@ Errors.with_ctx (BU.format1 "While checking layered effect definition `%s`" (str BU.format3 "Unexpected non-function type for action %s:%s (%s)" (string_of_lid ed.mname) (string_of_lid act.action_name) (Print.term_to_string act_typ)) r in - if Env.debug env <| Options.Other "LayeredEffectsTc" then + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print1 "Expected action type: %s\n" (Print.term_to_string k); let g = Rel.teq env act_typ k in List.iter (Rel.force_trivial_guard env) [g_t; g_d; g_k; g]; - if Env.debug env <| Options.Other "LayeredEffectsTc" then + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print1 "Expected action type after unification: %s\n" (Print.term_to_string k); let act_typ = @@ -1869,7 +1872,7 @@ Errors.with_ctx (BU.format1 "While checking layered effect definition `%s`" (str U.arrow bs (S.mk_Comp ct) | _ -> raise_error (Errors.Fatal_ActionMustHaveFunctionType, err_msg k) r in - if Env.debug env <| Options.Other "LayeredEffectsTc" then + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print1 "Action type after injecting it into the monad: %s\n" (Print.term_to_string act_typ); let act = @@ -1938,7 +1941,7 @@ Errors.with_ctx (BU.format1 "While checking layered effect definition `%s`" (str end in - if Env.debug env0 <| Options.Other "LayeredEffectsTc" + if !dbg_LayeredEffectsTc then BU.print2 "Effect %s has extraction mode %s\n" (string_of_lid ed.mname) (Print.eff_extraction_mode_to_string extraction_mode); @@ -1966,7 +1969,7 @@ Errors.with_ctx (BU.format1 "While checking layered effect definition `%s`" (str let tc_non_layered_eff_decl env0 (ed:S.eff_decl) (_quals : list qualifier) (_attrs : list S.attribute) : S.eff_decl = Errors.with_ctx (BU.format1 "While checking effect definition `%s`" (string_of_lid ed.mname)) (fun () -> - if Env.debug env0 <| Options.Other "ED" then + if !dbg then BU.print1 "Typechecking eff_decl: \n\t%s\n" (Print.eff_decl_to_string false ed); let us, bs = @@ -2026,7 +2029,7 @@ Errors.with_ctx (BU.format1 "While checking effect definition `%s`" (string_of_l action_typ = snd (op (a.action_univs, a.action_typ)) }) ed.actions; } in - if Env.debug env0 <| Options.Other "ED" then + if !dbg then BU.print1 "After typechecking binders eff_decl: \n\t%s\n" (Print.eff_decl_to_string false ed); let env = Env.push_binders (Env.push_univ_vars env0 ed_univs) ed_bs in @@ -2070,7 +2073,7 @@ Errors.with_ctx (BU.format1 "While checking effect definition `%s`" (string_of_l let signature = check_and_gen' "signature" 1 None (U.effect_sig_ts ed.signature) None in - if Env.debug env0 <| Options.Other "ED" then + if !dbg then BU.print1 "Typechecked signature: %s\n" (Print.tscheme_to_string signature); (* @@ -2090,7 +2093,7 @@ Errors.with_ctx (BU.format1 "While checking effect definition `%s`" (string_of_l in let log_combinator s ts = - if Env.debug env <| Options.Other "ED" then + if !dbg then BU.print3 "Typechecked %s:%s = %s\n" (string_of_lid ed.mname) s (Print.tscheme_to_string ts) in let ret_wp = @@ -2278,7 +2281,7 @@ Errors.with_ctx (BU.format1 "While checking effect definition `%s`" (string_of_l // 1) Check action definition, setting its expected type to // [action_typ] let env' = { Env.set_expected_typ env act_typ with instantiate_imp = false } in - if Env.debug env (Options.Other "ED") then + if !dbg then BU.print3 "Checking action %s:\n[definition]: %s\n[cps'd type]: %s\n" (string_of_lid act.action_name) (Print.term_to_string act.action_defn) (Print.term_to_string act_typ); @@ -2393,7 +2396,7 @@ Errors.with_ctx (BU.format1 "While checking effect definition `%s`" (string_of_l action_typ = cl (a.action_univs, a.action_typ) |> snd; action_defn = cl (a.action_univs, a.action_defn) |> snd }) actions } in - if Env.debug env <| Options.Other "ED" then + if !dbg then BU.print1 "Typechecked effect declaration:\n\t%s\n" (Print.eff_decl_to_string false ed); ed @@ -2421,7 +2424,7 @@ let monad_signature env m s = * *) let tc_layered_lift env0 (sub:S.sub_eff) : S.sub_eff = - if Env.debug env0 <| Options.Other "LayeredEffectsTc" then + if !dbg_LayeredEffectsTc then BU.print1 "Typechecking sub_effect: %s\n" (Print.sub_eff_to_string sub); let lift_ts = sub.lift |> must in @@ -2429,7 +2432,7 @@ let tc_layered_lift env0 (sub:S.sub_eff) : S.sub_eff = let us, lift, lift_ty = check_and_gen env0 "" "lift" 1 lift_ts in - if Env.debug env0 <| Options.Other "LayeredEffectsTc" then + if !dbg_LayeredEffectsTc then BU.print2 "Typechecked lift: %s and lift_ty: %s\n" (Print.tscheme_to_string (us, lift)) (Print.tscheme_to_string ((us, lift_ty))); @@ -2443,7 +2446,7 @@ let tc_layered_lift env0 (sub:S.sub_eff) : S.sub_eff = lift_wp = Some (us, k |> SS.close_univ_vars us); kind = Some kind } in - if Env.debug env0 <| Options.Other "LayeredEffectsTc" then + if !dbg_LayeredEffectsTc then BU.print1 "Final sub_effect: %s\n" (Print.sub_eff_to_string sub); sub @@ -2523,7 +2526,7 @@ let tc_lift env sub r = uvs, SS.subst usubst lift else [], lift in - if Env.debug env (Options.Other "ED") + if !dbg then BU.print1 "Lift for free : %s\n" (Print.term_to_string lift); let dmff_env = DMFF.empty env (tc_constant env Range.dummyRange) in let lift, comp, _ = tc_term (Env.push_univ_vars env uvs) lift in //AR: push univs in the env @@ -2712,7 +2715,7 @@ let tc_polymonadic_bind env (m:lident) (n:lident) (p:lident) (ts:S.tscheme) 0 false in - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print3 "Polymonadic bind %s after typechecking (%s::%s)\n" eff_name (Print.tscheme_to_string (us, t)) (Print.tscheme_to_string (us, k)); @@ -2753,7 +2756,7 @@ let tc_polymonadic_subcomp env0 (m:lident) (n:lident) (ts:S.tscheme) = 0 (Env.get_range env) in - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print3 "Polymonadic subcomp %s after typechecking (%s::%s)\n" combinator_name (Print.tscheme_to_string (us, t)) diff --git a/src/typechecker/FStar.TypeChecker.TcInductive.fst b/src/typechecker/FStar.TypeChecker.TcInductive.fst index b4dc322642f..847f3888f10 100644 --- a/src/typechecker/FStar.TypeChecker.TcInductive.fst +++ b/src/typechecker/FStar.TypeChecker.TcInductive.fst @@ -44,6 +44,9 @@ module U = FStar.Syntax.Util module PP = FStar.Syntax.Print module C = FStar.Parser.Const +let dbg_GenUniverses = Debug.get_toggle "GenUniverses" +let dbg_LogTypes = Debug.get_toggle "LogTypes" + let unfold_whnf = N.unfold_whnf' [Env.AllowUnboundUniverses] let tc_tycon (env:env_t) (* environment that contains all mutually defined type constructors *) @@ -165,7 +168,7 @@ let tc_data (env:env_t) (tcs : list (sigelt * universe)) | _ -> [], t in - if Env.debug env Options.Low then BU.print3 "Checking datacon %s : %s -> %s \n" + if Debug.low () then BU.print3 "Checking datacon %s : %s -> %s \n" (Print.lid_to_string c) (Print.binders_to_string "->" arguments) (Print.term_to_string result); @@ -257,10 +260,10 @@ let generalize_and_inst_within (env:env_t) (tcs:list (sigelt * universe)) (datas | Sig_datacon {t} -> S.null_binder t | _ -> failwith "Impossible") in let t = U.arrow (binders@binders') (S.mk_Total t_unit) in - if Env.debug env <| Options.Other "GenUniverses" + if !dbg_GenUniverses then BU.print1 "@@@@@@Trying to generalize universes in %s\n" (N.term_to_string env t); let (uvs, t) = Gen.generalize_universes env t in - if Env.debug env <| Options.Other "GenUniverses" + if !dbg_GenUniverses then BU.print2 "@@@@@@Generalized to (%s, %s)\n" (uvs |> List.map (fun u -> (string_of_id u)) |> String.concat ", ") (Print.term_to_string t); @@ -757,7 +760,7 @@ let check_inductive_well_typedness (env:env_t) (ses:list sigelt) (quals:list qua let env, tcs, g = List.fold_right (fun tc (env, all_tcs, g) -> let env, tc, tc_u, guard = tc_tycon env tc in let g' = Rel.universe_inequality S.U_zero tc_u in - if Env.debug env Options.Low then BU.print1 "Checked inductive: %s\n" (Print.sigelt_to_string tc); + if Debug.low () then BU.print1 "Checked inductive: %s\n" (Print.sigelt_to_string tc); env, (tc, tc_u)::all_tcs, Env.conj_guard g (Env.conj_guard guard g') ) tys (env, [], Env.trivial_guard) in @@ -776,7 +779,7 @@ let check_inductive_well_typedness (env:env_t) (ses:list sigelt) (quals:list qua let tc_universe_vars = List.map snd tcs in let g = {g with univ_ineqs=tc_universe_vars, snd (g.univ_ineqs)} in - if Env.debug env0 <| Options.Other "GenUniverses" + if !dbg_GenUniverses then BU.print1 "@@@@@@Guard before (possible) generalization: %s\n" (Rel.guard_to_string env g); Rel.force_trivial_guard env0 g; @@ -972,7 +975,7 @@ let mk_discriminator_and_indexed_projectors iquals (* Qualifie sigattrs = attrs; sigopts = None; sigopens_and_abbrevs=[] } in - if Env.debug env (Options.Other "LogTypes") + if !dbg_LogTypes then BU.print1 "Declaration of a discriminator %s\n" (Print.sigelt_to_string decl); if only_decl @@ -1015,7 +1018,7 @@ let mk_discriminator_and_indexed_projectors iquals (* Qualifie sigattrs = attrs; sigopts = None; sigopens_and_abbrevs=[] } in - if Env.debug env (Options.Other "LogTypes") + if !dbg_LogTypes then BU.print1 "Implementation of a discriminator %s\n" (Print.sigelt_to_string impl); (* TODO : Are there some cases where we don't want one of these ? *) (* If not the declaration is useless, isn't it ?*) @@ -1076,7 +1079,7 @@ let mk_discriminator_and_indexed_projectors iquals (* Qualifie sigattrs = attrs; sigopts = None; sigopens_and_abbrevs=[] } in - if Env.debug env (Options.Other "LogTypes") + if !dbg_LogTypes then BU.print1 "Declaration of a projector %s\n" (Print.sigelt_to_string decl); if only_decl then [decl] //only the signature @@ -1124,7 +1127,7 @@ let mk_discriminator_and_indexed_projectors iquals (* Qualifie sigattrs = attrs; sigopts = None; sigopens_and_abbrevs=[] } in - if Env.debug env (Options.Other "LogTypes") + if !dbg_LogTypes then BU.print1 "Implementation of a projector %s\n" (Print.sigelt_to_string impl); if no_decl then [impl] else [decl;impl]) |> List.flatten in diff --git a/src/typechecker/FStar.TypeChecker.TcTerm.fst b/src/typechecker/FStar.TypeChecker.TcTerm.fst index 82ae15e0d7c..659d41db17b 100644 --- a/src/typechecker/FStar.TypeChecker.TcTerm.fst +++ b/src/typechecker/FStar.TypeChecker.TcTerm.fst @@ -50,6 +50,16 @@ module PP = FStar.Syntax.Print module UF = FStar.Syntax.Unionfind module Const = FStar.Parser.Const +let dbg_Exports = Debug.get_toggle "Exports" +let dbg_LayeredEffects = Debug.get_toggle "LayeredEffects" +let dbg_NYC = Debug.get_toggle "NYC" +let dbg_Patterns = Debug.get_toggle "Patterns" +let dbg_Range = Debug.get_toggle "Range" +let dbg_RelCheck = Debug.get_toggle "RelCheck" +let dbg_RFD = Debug.get_toggle "RFD" +let dbg_Tac = Debug.get_toggle "Tac" +let dbg_UniverseOf = Debug.get_toggle "UniverseOf" + (* Some local utilities *) let instantiate_both env = {env with Env.instantiate_imp=true} let no_inst env = {env with Env.instantiate_imp=false} @@ -239,7 +249,7 @@ let value_check_expected_typ env (e:term) (tlc:either term lcomp) (guard:guard_t | None -> memo_tk e t, lc, guard | Some (t', use_eq) -> let e, lc, g = TcUtil.check_has_type_maybe_coerce env e lc t' use_eq in - if debug env Options.Medium + if Debug.medium () then BU.print4 "value_check_expected_typ: type is %s<:%s \tguard is %s, %s\n" (TcComm.lcomp_to_string lc) (Print.term_to_string t') (Rel.guard_to_string env g) (Rel.guard_to_string env guard); @@ -350,7 +360,7 @@ let check_expected_effect env (use_eq:bool) (copt:option comp) (ec : term * comp let c = TcUtil.maybe_assume_result_eq_pure_term env e (TcComm.lcomp_of_comp c) in let c, g_c = TcComm.lcomp_comp c in def_check_scoped c.pos "check_expected_effect.c.after_assume" env c; - if debug env <| Options.Medium then + if Debug.medium () then BU.print4 "In check_expected_effect, asking rel to solve the problem on e=(%s) and c=(%s), expected_c=(%s), and use_eq=%s\n" (Print.term_to_string e) (Print.comp_to_string c) @@ -358,7 +368,7 @@ let check_expected_effect env (use_eq:bool) (copt:option comp) (ec : term * comp (string_of_bool use_eq); let e, _, g = TcUtil.check_comp env use_eq e c expected_c in let g = TcUtil.label_guard (Env.get_range env) (Errors.mkmsg "Could not prove post-condition") g in - if debug env Options.Medium + if Debug.medium () then BU.print2 "(%s) DONE check_expected_effect;\n\tguard is: %s\n" (Range.string_of_range e.pos) (guard_to_string env g); @@ -498,7 +508,7 @@ let guard_letrecs env actuals expected_c : list (lbname*typ*univ_names) = let env = {env with letrecs=[]} in let decreases_clause bs c = - if debug env Options.Low + if Debug.low () then BU.print2 "Building a decreases clause over (%s) and %s\n" (Print.binders_to_string ", " bs) (Print.comp_to_string c); @@ -668,7 +678,7 @@ let guard_letrecs env actuals expected_c : list (lbname*typ*univ_names) = let last = {last with sort=U.refine last precedes} in let refined_formals = bs@[S.mk_binder_with_attrs last imp pqual attrs] in let t' = U.arrow refined_formals c in - if debug env Options.Medium + if Debug.medium () then BU.print3 "Refined let rec %s\n\tfrom type %s\n\tto type %s\n" (Print.lbname_to_string l) (Print.term_to_string t) (Print.term_to_string t'); l, t', u_names @@ -709,7 +719,7 @@ let is_comp_ascribed_reflect (e:term) : option (lident * term * aqual) = (************************************************************************************************************) let rec tc_term env e = def_check_scoped e.pos "tc_term.entry" env e; - if Env.debug env Options.Medium then + if Debug.medium () then BU.print5 "(%s) Starting tc_term (phase1=%s) of %s (%s), %s {\n" (Range.string_of_range <| Env.get_range env) (string_of_bool env.phase1) @@ -719,7 +729,7 @@ let rec tc_term env e = let r, ms = BU.record_time (fun () -> tc_maybe_toplevel_term ({env with top_level=false}) e) in - if Env.debug env Options.Medium then begin + if Debug.medium () then begin BU.print4 "(%s) } tc_term of %s (%s) took %sms\n" (Range.string_of_range <| Env.get_range env) (Print.term_to_string e) (Print.tag_of_term (SS.compress e)) @@ -738,7 +748,7 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked let env = if e.pos=Range.dummyRange then env else Env.set_range env e.pos in def_check_scoped e.pos "tc_maybe_toplevel_term.entry" env e; let top = SS.compress e in - if debug env Options.Medium then + if Debug.medium () then BU.print3 "Typechecking %s (%s): %s\n" (show <| Env.get_range env) (Print.tag_of_term top) (show top); match top.n with | Tm_delayed _ -> failwith "Impossible" @@ -934,14 +944,14 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked // e <: Tot repr let e = S.mk (Tm_ascribed {tm=e; asc=(Inr (S.mk_Total repr), None, use_eq); eff_opt=None}) e.pos in - if Env.debug env0 <| Options.Extreme + if Debug.extreme () then BU.print1 "Typechecking ascribed reflect, inner ascribed term: %s\n" (Print.term_to_string e); let e, _, g_e = tc_tot_or_gtot_term env0 e in let e = U.unascribe e in - if Env.debug env0 <| Options.Extreme + if Debug.extreme () then BU.print2 "Typechecking ascribed reflect, after typechecking inner ascribed term: %s and guard: %s\n" (Print.term_to_string e) (Rel.guard_to_string env0 g_e); @@ -1204,7 +1214,7 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked begin let t0 = N.unfold_whnf' [Unascribe; Unmeta; Unrefine] env lc.res_typ in let thead, _ = U.head_and_args t0 in - if Env.debug env <| Options.Other "RFD" + if !dbg_RFD then ( BU.print3 "Got lc.res_typ=%s; t0 = %s; thead = %s\n" (Print.term_to_string lc.res_typ) @@ -1268,7 +1278,7 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked | Tm_app {hd=head; args} -> let env0 = env in let env = Env.clear_expected_typ env |> fst |> instantiate_both in - if debug env Options.High + if Debug.high () then BU.print3 "(%s) Checking app %s, %s\n" (Range.string_of_range top.pos) (Print.term_to_string top) @@ -1298,12 +1308,12 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked e, TcComm.set_result_typ_lc c res_typ, implicits else e, c, Env.trivial_guard in - if Env.debug env Options.Extreme + if Debug.extreme () then BU.print1 "Introduced {%s} implicits in application\n" (Rel.print_pending_implicits g); let e, c, g' = comp_check_expected_typ env0 e c in let gres = Env.conj_guard g g' in let gres = Env.conj_guard gres implicits in - if Env.debug env Options.Extreme + if Debug.extreme () then BU.print2 "Guard from application node %s is %s\n" (Print.term_to_string e) (Rel.guard_to_string env gres); @@ -1589,7 +1599,7 @@ and tc_match (env : Env.env) (top : term) : term * lcomp * guard_t = | None -> e, cres, Env.trivial_guard | _ -> comp_check_expected_typ env e cres in - if debug env Options.Extreme + if Debug.extreme () then BU.print2 "(%s) Typechecked Tm_match, comp type = %s\n" (Range.string_of_range top.pos) (TcComm.lcomp_to_string cres); @@ -1609,7 +1619,7 @@ and tc_synth head env args rng = raise_error (Errors.Fatal_SynthByTacticError, "synth_by_tactic: bad application") rng in - if Env.debug env <| Options.Other "Tac" then + if !dbg_Tac then BU.print2 "Processing synth of %s at type %s\n" (show tau) (show atyp); let typ = @@ -1637,7 +1647,7 @@ and tc_synth head env args rng = Rel.force_trivial_guard env g2; let t = env.synth_hook env typ ({ tau with pos = rng }) in - if Env.debug env <| Options.Other "Tac" then + if !dbg_Tac then BU.print1 "Got %s\n" (Print.term_to_string t); // Should never trigger, meta-F* will check it before. @@ -1779,7 +1789,7 @@ and tc_value env (e:term) : term let (us, t), range = Env.lookup_lid env fv.fv_name.v in let fv = S.set_range_of_fv fv range in maybe_warn_on_use env fv; - if Env.debug env <| Options.Other "Range" + if !dbg_Range then BU.print5 "Lookup up fvar %s at location %s (lid range = defined at %s, used at %s); got universes type %s\n" (Print.lid_to_string (lid_of_fv fv)) (Range.string_of_range e.pos) @@ -1826,7 +1836,7 @@ and tc_value env (e:term) : term let env0 = env in let env, _ = Env.clear_expected_typ env in let x, env, f1, u = tc_binder env (List.hd x) in - if debug env Options.High + if Debug.high () then BU.print3 "(%s) Checking refinement formula %s; binder is %s\n" (Range.string_of_range top.pos) (Print.term_to_string phi) (Print.bv_to_string x.binder_bv); let t_phi, _ = U.type_u () in @@ -1841,7 +1851,7 @@ and tc_value env (e:term) : term | Tm_abs {bs; body} -> (* in case we use type variables which are implicitly quantified, we add quantifiers here *) let bs = TcUtil.maybe_add_implicit_binders env bs in - if Env.debug env Options.Medium + if Debug.medium () then BU.print1 "Abstraction is: %s\n" (Print.term_to_string ({top with n=Tm_abs {bs; body; rc_opt=None}})); let bs, body = SS.open_term bs body in tc_abs env top bs body @@ -2188,7 +2198,7 @@ and tc_abs_check_binders env bs bs_expected use_eq * 2) add an extra guard that the two types must be equal (use_eq will be used in Rel.teq *) | _ -> - if Env.debug env Options.High then BU.print1 "Checking binder %s\n" (Print.bv_to_string hd); + if Debug.high () then BU.print1 "Checking binder %s\n" (Print.bv_to_string hd); let t, _, g1_env = tc_tot_or_gtot_term env hd.sort in let g2_env = let label_guard g = @@ -2247,7 +2257,7 @@ and tc_abs env (top:term) (bs:binders) (body:term) : term * lcomp * guard_t = (* topt is the expected type of the expression obtained from the env *) let env, topt = Env.clear_expected_typ env in - if Env.debug env Options.High + if Debug.high () then BU.print2 "!!!!!!!!!!!!!!!Expected type is (%s), top_level=%s\n" (match topt with | None -> "None" @@ -2257,7 +2267,7 @@ and tc_abs env (top:term) (bs:binders) (body:term) : term * lcomp * guard_t = let tfun_opt, bs, letrec_binders, c_opt, envbody, body, g_env = tc_abs_expected_function_typ env bs topt body in - if Env.debug env Options.Extreme + if Debug.extreme () then BU.print3 "After expected_function_typ, tfun_opt: %s, c_opt: %s, and expected type in envbody: %s\n" (match tfun_opt with | None -> "None" @@ -2269,7 +2279,7 @@ and tc_abs env (top:term) (bs:binders) (body:term) : term * lcomp * guard_t = | None -> "None" | Some (t, use_eq) -> Print.term_to_string t ^ ", use_eq = " ^ string_of_bool use_eq); - if Env.debug env <| Options.Other "NYC" + if !dbg_NYC then BU.print2 "!!!!!!!!!!!!!!!Guard for function with binders %s is %s\n" (Print.binders_to_string ", " bs) (guard_to_string env g_env); @@ -2341,7 +2351,7 @@ and tc_abs env (top:term) (bs:binders) (body:term) : term * lcomp * guard_t = body, cbody, Env.conj_guard guard_body g_lc in - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print1 "tc_abs: guard_body: %s\n" (Rel.guard_to_string env guard_body); @@ -2351,7 +2361,7 @@ and tc_abs env (top:term) (bs:binders) (body:term) : term * lcomp * guard_t = only typeable in the extended environment which contains the Binding_lids. Closing the guard (below) won't help with that. *) if env.top_level then ( - if Env.debug env <| Options.Medium then + if Debug.medium () then BU.print1 "tc_abs: FORCING guard_body: %s\n" (Rel.guard_to_string env guard_body); Rel.discharge_guard envbody guard_body ) else ( @@ -2442,7 +2452,7 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term let n_args = List.length args in let r = Env.get_range env in let thead = U.comp_result chead in - if debug env Options.High then + if Debug.high () then BU.print3 "(%s) Type of head is %s\nArgs = %s\n" (show head.pos) (show thead) (show args); (* given |- head : chead | ghead @@ -2495,7 +2505,7 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term U.set_result_typ cres rt, Env.conj_guard g0 guard in - if debug env Options.Medium + if Debug.medium () then BU.print1 "\t Type of result cres is %s\n" (Print.comp_to_string cres); @@ -2543,9 +2553,9 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term if TcComm.is_pure_or_ghost_lcomp cres && (head_is_pure_and_some_arg_is_effectful) // || Option.isSome (Env.expected_typ env)) - then let _ = if Env.debug env Options.Extreme then BU.print1 "(a) Monadic app: Return inserted in monadic application: %s\n" (Print.term_to_string term) in + then let _ = if Debug.extreme () then BU.print1 "(a) Monadic app: Return inserted in monadic application: %s\n" (Print.term_to_string term) in TcUtil.maybe_assume_result_eq_pure_term env term cres, true - else let _ = if Env.debug env Options.Extreme then BU.print1 "(a) Monadic app: No return inserted in monadic application: %s\n" (Print.term_to_string term) in + else let _ = if Debug.extreme () then BU.print1 "(a) Monadic app: No return inserted in monadic application: %s\n" (Print.term_to_string term) in cres, false in @@ -2591,7 +2601,7 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term let _, comp = List.fold_left (fun (i, out_c) ((e, q), x, c) -> - if Env.debug env Options.Extreme then + if Debug.extreme () then BU.print3 "(b) Monadic app: Binding argument %s : %s of type (%s)\n" (match x with | None -> "_" | Some x -> Print.bv_to_string x) @@ -2618,7 +2628,7 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term //Bind head //Push all arg ret names in the env let env = push_option_names_to_env env arg_rets_names_opt in - if Env.debug env Options.Extreme + if Debug.extreme () then BU.print2 "(c) Monadic app: Binding head %s, chead: %s\n" (Print.term_to_string head) @@ -2655,11 +2665,11 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term (* a fresh variable and lift the actual argument to comp. *) let lifted_args, head, args = let map_fun ((e, q), _ , c) = - if Env.debug env Options.Extreme then + if Debug.extreme () then BU.print2 "For arg e=(%s) c=(%s)... " (Print.term_to_string e) (TcComm.lcomp_to_string c); if TcComm.is_pure_or_ghost_lcomp c then begin - if Env.debug env Options.Extreme then + if Debug.extreme () then BU.print_string "... not lifting\n"; None, (e, q) end else begin @@ -2675,7 +2685,7 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term Errors.log_issue e.pos (Errors.Warning_EffectfulArgumentToErasedFunction, (format3 "Effectful argument %s (%s) to erased function %s, consider let binding it" (show e) (show c.eff_name) (show head))); - if Env.debug env Options.Extreme then + if Debug.extreme () then BU.print_string "... lifting!\n"; let x = S.new_bv None c.res_typ in let e = TcUtil.maybe_lift env e c.eff_name comp.eff_name c.res_typ in @@ -2708,7 +2718,7 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term //NS: Maybe redundant strengthen // let comp, g = comp, guard in let comp, g = TcUtil.strengthen_precondition None env app comp guard in - if Env.debug env Options.Extreme then BU.print2 "(d) Monadic app: type of app\n\t(%s)\n\t: %s\n" + if Debug.extreme () then BU.print2 "(d) Monadic app: type of app\n\t(%s)\n\t: %s\n" (show app) (TcComm.lcomp_to_string comp); app, comp, g @@ -2816,12 +2826,12 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term let targ = SS.subst subst x.sort in let bqual = SS.subst_bqual subst bqual in let x = {x with sort=targ} in - if debug env Options.Extreme + if Debug.extreme () then BU.print5 "\tFormal is %s : %s\tType of arg %s (after subst %s) = %s\n" (show x) (show x.sort) (show e) (show subst) (show targ); let targ, g_ex = check_no_escape (Some head) env fvs targ in let env = Env.set_expected_typ_maybe_eq env targ (is_eq bqual) in - if debug env Options.High + if Debug.high () then BU.print4 "Checking arg (%s) %s at type %s with use_eq:%s\n" (Print.tag_of_term e) (Print.term_to_string e) @@ -2850,7 +2860,7 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term | Tm_arrow {bs; comp=cres'} -> let bs, cres' = SS.open_comp bs cres' in let head_info = (head, chead, ghead, cres') in - if debug env Options.Low + if Debug.low () then FStar.Errors.log_issue tres.pos (Errors.Warning_RedundantExplicitCurrying, "Potentially redundant explicit currying of a function type"); tc_args head_info ([], [], [], Env.trivial_guard, []) bs args @@ -2898,7 +2908,7 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term else S.mk_Total t, Env.conj_guard guard g in let bs_cres = U.arrow bs cres in - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print3 "Forcing the type of %s from %s to %s\n" (Print.term_to_string head) (Print.term_to_string tf) @@ -2910,7 +2920,7 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term | Tm_arrow {bs; comp=c} -> let bs, c = SS.open_comp bs c in let head_info = head, chead, ghead, c in - if Env.debug env Options.Extreme + if Debug.extreme () then BU.print4 "######tc_args of head %s @ %s with formals=%s and result type=%s\n" (Print.term_to_string head) (Print.term_to_string tf) @@ -3011,7 +3021,7 @@ and tc_pat env (pat_t:typ) (p0:pat) : aux false (N.normalize [Env.Beta;Env.Iota] env scrutinee_t) in let pat_typ_ok env pat_t scrutinee_t : guard_t = - if Env.debug env <| Options.Other "Patterns" + if !dbg_Patterns then BU.print2 "$$$$$$$$$$$$pat_typ_ok? %s vs. %s\n" (Print.term_to_string pat_t) (Print.term_to_string scrutinee_t); @@ -3194,7 +3204,7 @@ and tc_pat env (pat_t:typ) (p0:pat) : * pat * guard_t * bool = - if Env.debug env <| Options.Other "Patterns" + if !dbg_Patterns then BU.print2 "Checking pattern %s at type %s\n" (Print.pat_to_string p) (Print.term_to_string t); let id t = mk_Tm_app @@ -3371,7 +3381,7 @@ and tc_pat env (pat_t:typ) (p0:pat) : {guard with guard_f=fml} in // And combine with g' (the guard from pat_typ_ok) let guard = Env.conj_guard guard g' in - if Env.debug env <| Options.Other "Patterns" + if !dbg_Patterns then BU.print3 "$$$$$$$$$$$$Checked simple pattern %s at type %s with bvs=%s\n" (Print.term_to_string simple_pat_e) (Print.term_to_string simple_pat_t) @@ -3440,7 +3450,7 @@ and tc_pat env (pat_t:typ) (p0:pat) : g, erasable in - if Env.debug env <| Options.Other "Patterns" + if !dbg_Patterns then BU.print1 "Checking pattern: %s\n" (Print.pat_to_string p0); let bvs, tms, pat_e, pat, g, erasable = check_nested_pattern @@ -3450,7 +3460,7 @@ and tc_pat env (pat_t:typ) (p0:pat) : in let extended_env = Env.push_bvs env bvs in let pat_e_norm = N.normalize [Env.Beta] extended_env pat_e in - if Env.debug env <| Options.Other "Patterns" + if !dbg_Patterns then BU.print2 "Done checking pattern %s as expression %s\n" (Print.pat_to_string pat) (Print.term_to_string pat_e); @@ -3498,7 +3508,7 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti tc_pat (Env.push_bv env scrutinee) pat_t pattern in - if Env.debug env <| Options.Extreme then + if Debug.extreme () then BU.print3 "tc_eqn: typechecked pattern %s with bvs %s and pat_bv_tms %s\n" (Print.pat_to_string pattern) (Print.bvs_to_string ";" pat_bvs) (List.fold_left (fun s t -> s ^ ";" ^ (Print.term_to_string t)) "" pat_bv_tms); @@ -3687,7 +3697,7 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti branch_guard in - if Env.debug env <| Options.Extreme then + if Debug.extreme () then BU.print1 "tc_eqn: branch guard : %s\n" (Print.term_to_string branch_guard); (* 6 (a). Build equality conditions between the pattern and the scrutinee *) @@ -3776,7 +3786,7 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti if close_branch_with_substitutions then let _ = - if Env.debug env <| Options.Other "LayeredEffects" + if !dbg_LayeredEffects then BU.print_string "Typechecking pat_bv_tms ...\n" in (* @@ -3819,7 +3829,7 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti |> List.map (N.normalize [Env.Beta] env) in let _ = - if Env.debug env <| Options.Other "LayeredEffects" + if !dbg_LayeredEffects then BU.print2 "tc_eqn: typechecked pat_bv_tms %s (pat_bvs : %s)\n" (List.fold_left (fun s t -> s ^ ";" ^ (Print.term_to_string t)) "" pat_bv_tms) (List.fold_left (fun s t -> s ^ ";" ^ (Print.bv_to_string t)) "" pat_bvs) in @@ -3841,7 +3851,7 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti let guard = Env.conj_guard g_when g_branch in - if Env.debug env Options.High + if Debug.high () then BU.print1 "Carrying guard from match: %s\n" <| guard_to_string env guard; SS.close_branch (pattern, when_clause, branch_exp), @@ -3886,7 +3896,7 @@ and check_top_level_let env e = in (* Unfold all @tcnorm subterms in the binding *) - if Env.debug env Options.Medium then + if Debug.medium () then BU.print1 "Let binding BEFORE tcnorm: %s\n" (Print.term_to_string e1); let e1 = if Options.tcnorm () then N.normalize [Env.UnfoldAttr [Const.tcnorm_attr]; @@ -3894,7 +3904,7 @@ and check_top_level_let env e = Env.NoFullNorm; Env.DoNotUnfoldPureLets] env e1 else e1 in - if Env.debug env Options.Medium then + if Debug.medium () then BU.print1 "Let binding AFTER tcnorm: %s\n" (Print.term_to_string e1); (* @@ -4023,14 +4033,14 @@ and check_inner_let env e = if Option.isSome (Env.expected_typ env) then (let tt = Env.expected_typ env |> Option.get |> fst in - if Env.debug env <| Options.Other "Exports" + if !dbg_Exports then BU.print2 "Got expected type from env %s\ncres.res_typ=%s\n" (Print.term_to_string tt) (Print.term_to_string cres.res_typ); e, cres, guard) else (* no expected type; check that x doesn't escape it's scope *) (let t, g_ex = check_no_escape None env [x] cres.res_typ in - if Env.debug env <| Options.Other "Exports" + if !dbg_Exports then BU.print2 "Checked %s has no escaping types; normalized to %s\n" (Print.term_to_string cres.res_typ) (Print.term_to_string t); @@ -4265,7 +4275,7 @@ and build_let_rec_env _top_level env lbs : list letbinding * env_t * guard_t = // tc_abs adding universes here so that when we add the let binding, we // can add a typescheme with these universes | Some (arity, lbdef) -> - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print2 "termination_check_enabled returned arity: %s and lbdef: %s\n" (string_of_int arity) (Print.term_to_string lbdef); let lb = {lb with lbtyp=lbtyp; lbunivs=univ_vars; lbdef=lbdef} in @@ -4363,7 +4373,7 @@ and check_let_bound_def top_level env lb (Env.set_range env1 e1.pos) e1 c1 wf_annot in let g1 = Env.conj_guard g1 guard_f in - if Env.debug env Options.Extreme + if Debug.extreme () then BU.print3 "checked let-bound def %s : %s guard is %s\n" (Print.lbname_to_string lb.lbname) (TcComm.lcomp_to_string c1) @@ -4399,7 +4409,7 @@ and check_lbtyp top_level env lb : option typ (* checked version of lb.lbtyp, i else //we have an inline annotation let k, _ = U.type_u () in let t, _, g = tc_check_tot_or_gtot_term env1 t k "" in - if debug env Options.Medium + if Debug.medium () then BU.print2 "(%s) Checked type annotation %s\n" (Range.string_of_range (range_of_lbname lb.lbname)) (Print.term_to_string t); @@ -4409,7 +4419,7 @@ and check_lbtyp top_level env lb : option typ (* checked version of lb.lbtyp, i and tc_binder env ({binder_bv=x;binder_qual=imp;binder_positivity=pqual;binder_attrs=attrs}) = let tu, u = U.type_u () in - if Env.debug env Options.Extreme + if Debug.extreme () then BU.print3 "Checking binder %s:%s at type %s\n" (Print.bv_to_string x) (Print.term_to_string x.sort) @@ -4426,12 +4436,12 @@ and tc_binder env ({binder_bv=x;binder_qual=imp;binder_positivity=pqual;binder_a let g = Env.conj_guard g g_attrs in check_erasable_binder_attributes env attrs t; let x = S.mk_binder_with_attrs ({x with sort=t}) imp pqual attrs in - if Env.debug env Options.High + if Debug.high () then BU.print2 "Pushing binder %s at type %s\n" (Print.bv_to_string x.binder_bv) (Print.term_to_string t); x, push_binding env x, g, u and tc_binders env bs = - if Env.debug env Options.Extreme then + if Debug.extreme () then BU.print1 "Checking binders %s\n" (Print.binders_to_string ", " bs); let rec aux env bs = match bs with | [] -> [], env, Env.trivial_guard, [] @@ -4514,7 +4524,7 @@ let tc_check_trivial_guard env t k = in environment env *) let typeof_tot_or_gtot_term env e must_tot = - if Env.debug env <| Options.Other "RelCheck" then BU.print1 "Checking term %s\n" (Print.term_to_string e); + if !dbg_RelCheck then BU.print1 "Checking term %s\n" (Print.term_to_string e); //let env, _ = Env.clear_expected_typ env in let env = {env with top_level=false; letrecs=[]} in let t, c, g = @@ -4716,7 +4726,7 @@ let rec universe_of_aux env e : term = | _ -> let env, _ = Env.clear_expected_typ env in let env = {env with lax=true; top_level=false} in - if Env.debug env <| Options.Other "UniverseOf" + if !dbg_UniverseOf then BU.print2 "%s: About to type-check %s\n" (Range.string_of_range (Env.get_range env)) (Print.term_to_string hd); @@ -4738,12 +4748,12 @@ let rec universe_of_aux env e : term = let universe_of env e = Errors.with_ctx "While attempting to compute a universe level" (fun () -> - if debug env Options.High then + if Debug.high () then BU.print1 "Calling universe_of_aux with %s {\n" (Print.term_to_string e); def_check_scoped e.pos "universe_of entry" env e; let r = universe_of_aux env e in - if debug env Options.High then + if Debug.high () then BU.print1 "Got result from universe_of_aux = %s }\n" (Print.term_to_string r); level_of_type env e r ) diff --git a/src/typechecker/FStar.TypeChecker.Util.fst b/src/typechecker/FStar.TypeChecker.Util.fst index 1a1628cbc97..cf509784616 100644 --- a/src/typechecker/FStar.TypeChecker.Util.fst +++ b/src/typechecker/FStar.TypeChecker.Util.fst @@ -49,6 +49,19 @@ module UF = FStar.Syntax.Unionfind open FStar.Class.Setlike +let dbg_bind = Debug.get_toggle "Bind" +let dbg_Coercions = Debug.get_toggle "Coercions" +let dbg_Dec = Debug.get_toggle "Dec" +let dbg_Extraction = Debug.get_toggle "Extraction" +let dbg_LayeredEffects = Debug.get_toggle "LayeredEffects" +let dbg_LayeredEffectsApp = Debug.get_toggle "LayeredEffectsApp" +let dbg_Pat = Debug.get_toggle "Pat" +let dbg_Rel = Debug.get_toggle "Rel" +let dbg_ResolveImplicitsHook = Debug.get_toggle "ResolveImplicitsHook" +let dbg_Return = Debug.get_toggle "Return" +let dbg_Simplification = Debug.get_toggle "Simplification" +let dbg_SMTEncodingReify = Debug.get_toggle "SMTEncodingReify" + //Reporting errors let report env errs = Errors.log_issue (Env.get_range env) @@ -67,7 +80,7 @@ let close_guard_implicits env solve_deferred (xs:binders) (g:guard_t) : guard_t let solve_now, defer = g.deferred |> List.partition (fun (_, _, p) -> Rel.flex_prob_closing env xs p) in - if Env.debug env <| Options.Other "Rel" + if !dbg_Rel then begin BU.print_string "SOLVE BEFORE CLOSING:\n"; List.iter (fun (_, s, p) -> BU.print2 "%s: %s\n" s (Rel.prob_to_string env p)) solve_now; @@ -187,7 +200,7 @@ let extract_let_rec_annotation env {lbname=lbname; lbunivs=univ_vars; lbtyp=t; l let u_subst, univ_vars = SS.univ_var_opening univ_vars in let e = SS.subst u_subst e in let t = SS.subst u_subst t in - if Env.debug env <| Options.Other "Dec" + if !dbg_Dec then BU.print2 "extract_let_rec_annotation lbdef=%s; lbtyp=%s\n" (Print.term_to_string e) (Print.term_to_string t); @@ -385,7 +398,7 @@ let extract_let_rec_annotation env {lbname=lbname; lbunivs=univ_vars; lbtyp=t; l // | Pat_var x, Tm_name y -> // if not (bv_eq x y) // then failwith (BU.format2 "Expected pattern variable %s; got %s" (Print.bv_to_string x) (Print.bv_to_string y)); -// if Env.debug env <| Options.Other "Pat" +// if !dbg_Pat // then BU.print2 "Pattern variable %s introduced at type %s\n" (Print.bv_to_string x) (Normalize.term_to_string env y.sort); // let s = Normalize.normalize [Env.Beta] env y.sort in // let x = {x with sort=s} in @@ -535,7 +548,7 @@ let mk_wp_return env (ed:S.eff_decl) (u_a:universe) (a:typ) (e:term) (r:Range.ra e.pos in mk_comp ed u_a a wp [RETURN] in - if debug env <| Options.Other "Return" + if !dbg_Return then BU.print3 "(%s) returning %s at comp type %s\n" (Range.string_of_range e.pos) (P.term_to_string e) @@ -715,7 +728,7 @@ let substitutive_indexed_close_substs (env:env) : list subst_elt = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in // go through the binders bs and aggregate substitutions let close_bs, subst = @@ -856,7 +869,7 @@ let substitutive_indexed_bind_substs env : list subst_elt & guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in let bind_name () = if debug @@ -982,7 +995,7 @@ let ad_hoc_indexed_bind_substs env : list subst_elt & guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in let bind_name () = if debug @@ -1023,7 +1036,7 @@ let ad_hoc_indexed_bind_substs env (Print.binder_to_string b) (bind_name ()) (Range.string_of_range r1) else "ad_hoc_indexed_bind_substs") r1 in - if Env.debug env <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then rest_bs_uvars |> List.iter (fun t -> match (SS.compress t).n with @@ -1045,7 +1058,7 @@ let ad_hoc_indexed_bind_substs env (U.is_layered m_ed) r1 |> List.map (SS.subst subst) in List.fold_left2 (fun g i1 f_i1 -> - if Env.debug env <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then BU.print2 "Generating constraint %s = %s\n" (Print.term_to_string i1) (Print.term_to_string f_i1); @@ -1073,7 +1086,7 @@ let ad_hoc_indexed_bind_substs env let env_g = Env.push_binders env [x_a] in List.fold_left2 (fun g i1 g_i1 -> - if Env.debug env <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then BU.print2 "Generating constraint %s = %s\n" (Print.term_to_string i1) (Print.term_to_string g_i1); @@ -1095,7 +1108,7 @@ let ad_hoc_indexed_bind_substs env let mk_indexed_return env (ed:S.eff_decl) (u_a:universe) (a:typ) (e:term) (r:Range.range) : comp * guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in if debug then BU.print4 "Computing %s.return for u_a:%s, a:%s, and e:%s{\n" @@ -1160,13 +1173,13 @@ let mk_indexed_bind env (has_range_binders:bool) : comp * guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in if debug then BU.print2 "Binding indexed effects: c1:%s and c2:%s {\n" (Print.comp_to_string (S.mk_Comp ct1)) (Print.comp_to_string (S.mk_Comp ct2)); - if Env.debug env <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then BU.print2 "///////////////////////////////Bind at %s/////////////////////\n\ with bind_t = %s\n" (Range.string_of_range (Env.get_range env)) @@ -1229,7 +1242,7 @@ let mk_indexed_bind env Env.guard_of_guard_formula (TcComm.NonTrivial fml)] in - if Env.debug env <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then BU.print2 "///////////////////////////////EndBind at %s/////////////////////\n\ guard = %s\n" (Range.string_of_range (Env.get_range env)) @@ -1447,7 +1460,7 @@ let strengthen_precondition match guard_form g0 with | Trivial -> c, g_c | NonTrivial f -> - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print2 "-------------Strengthening pre-condition of term %s with guard %s\n" (N.term_to_string env e_for_debugging_only) (N.term_to_string env f); @@ -1496,8 +1509,7 @@ let maybe_capture_unit_refinement (env:env) (t:term) (x:bv) (c:comp) : comp * gu let bind (r1:Range.range) (env:Env.env) (e1opt:option term) (lc1:lcomp) ((b, lc2):lcomp_with_binder) : lcomp = let debug f = - if debug env Options.Extreme - || debug env <| Options.Other "bind" + if Debug.extreme () || !dbg_bind then f () in let lc1, lc2 = N.ghost_to_pure_lcomp2 env (lc1, lc2) in //downgrade from ghost to pure, if possible @@ -1829,7 +1841,7 @@ let substitutive_indexed_ite_substs (env:env) : list subst_elt & guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in // go through the binders bs and aggregate substitutions and guards @@ -1911,7 +1923,7 @@ let ad_hoc_indexed_ite_substs (env:env) : list subst_elt & guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in let conjunction_name () = if debug then BU.format1 "%s.conjunction" (string_of_lid ct_then.effect_name) @@ -1974,7 +1986,7 @@ let ad_hoc_indexed_ite_substs (env:env) let mk_layered_conjunction env (ed:S.eff_decl) (u_a:universe) (a:term) (p:typ) (ct1:comp_typ) (ct2:comp_typ) (r:Range.range) : comp * guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in let conjunction_t_error (s:string) = Errors.Fatal_UnexpectedEffect, [ @@ -2246,7 +2258,7 @@ let bind_cases env0 (res_t:typ) let check_comp env (use_eq:bool) (e:term) (c:comp) (c':comp) : term * comp * guard_t = def_check_scoped c.pos "check_comp.c" env c; def_check_scoped c'.pos "check_comp.c'" env c'; - if Env.debug env <| Options.Extreme then + if Debug.extreme () then BU.print4 "Checking comp relation:\n%s has type %s\n\t %s \n%s\n" (Print.term_to_string e) (Print.comp_to_string c) @@ -2318,7 +2330,7 @@ let coerce_with (env:Env.env) : term * lcomp = match Env.try_lookup_lid env f with | Some _ -> - if Env.debug env (Options.Other "Coercions") then + if !dbg_Coercions then BU.print1 "Coercing with %s!\n" (Ident.string_of_lid f); let lc2 = TcComm.lcomp_of_comp <| comp2 in let lc_res = bind e.pos env (Some e) lc (None, lc2) in @@ -2404,7 +2416,7 @@ let rec check_erased (env:Env.env) (t:term) : isErased = | _ -> No in - (* if Options.debug_any () then *) + (* if Debug.any () then *) (* BU.print2 "check_erased (%s) = %s\n" *) (* (Print.term_to_string t) *) (* (match r with *) @@ -2548,7 +2560,7 @@ let maybe_coerce_lc env (e:term) (lc:lcomp) (exp_t:term) : term * lcomp * guard_ if not should_coerce then (e, lc, Env.trivial_guard) else - let _ = if Env.debug env (Options.Other "Coercions") then + let _ = if !dbg_Coercions then BU.print4 "(%s) Trying to coerce %s from type (%s) to type (%s)\n" (Range.string_of_range e.pos) (Print.term_to_string e) @@ -2557,7 +2569,7 @@ let maybe_coerce_lc env (e:term) (lc:lcomp) (exp_t:term) : term * lcomp * guard_ in match find_coercion env lc exp_t e with | Some (coerced, lc, g) -> - let _ = if Env.debug env (Options.Other "Coercions") then + let _ = if !dbg_Coercions then BU.print3 "(%s) COERCING %s to %s\n" (Range.string_of_range e.pos) (Print.term_to_string e) @@ -2565,7 +2577,7 @@ let maybe_coerce_lc env (e:term) (lc:lcomp) (exp_t:term) : term * lcomp * guard_ in coerced, lc, g | None -> - let _ = if Env.debug env (Options.Other "Coercions") then + let _ = if !dbg_Coercions then BU.print1 "(%s) No user coercion found\n" (Range.string_of_range e.pos) in @@ -2614,7 +2626,7 @@ let maybe_coerce_lc env (e:term) (lc:lcomp) (exp_t:term) : term * lcomp * guard_ e, lc, Env.trivial_guard let weaken_result_typ env (e:term) (lc:lcomp) (t:typ) (use_eq:bool) : term * lcomp * guard_t = - if Env.debug env Options.High then + if Debug.high () then BU.print3 "weaken_result_typ e=(%s) lc=(%s) t=(%s)\n" (Print.term_to_string e) (TcComm.lcomp_to_string lc) @@ -2655,7 +2667,7 @@ let weaken_result_typ env (e:term) (lc:lcomp) (t:typ) (use_eq:bool) : term * lco let set_result_typ (c:comp) :comp = Util.set_result_typ c t in if Util.eq_tm t res_t = Util.Equal then begin //if the two types res_t and t are same, then just set the result type - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print2 "weaken_result_type::strengthen_trivial: res_t:%s is same as t:%s\n" (Print.term_to_string res_t) (Print.term_to_string t); set_result_typ c, g_c @@ -2676,13 +2688,13 @@ let weaken_result_typ env (e:term) (lc:lcomp) (t:typ) (use_eq:bool) : term * lco (comp_univ_opt c) res_t (S.bv_to_name x) in //AR: an M_M bind let lc = bind e.pos env (Some e) (TcComm.lcomp_of_comp c) (Some x, TcComm.lcomp_of_comp cret) in - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print4 "weaken_result_type::strengthen_trivial: inserting a return for e: %s, c: %s, t: %s, and then post return lc: %s\n" (Print.term_to_string e) (Print.comp_to_string c) (Print.term_to_string t) (TcComm.lcomp_to_string lc); let c, g_lc = TcComm.lcomp_comp lc in set_result_typ c, Env.conj_guards [g_c; gret; g_lc] else begin - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print2 "weaken_result_type::strengthen_trivial: res_t:%s is not a refinement, leaving c:%s as is\n" (Print.term_to_string res_t) (Print.comp_to_string c); set_result_typ c, g_c @@ -2709,7 +2721,7 @@ let weaken_result_typ env (e:term) (lc:lcomp) (t:typ) (use_eq:bool) : term * lco | _ -> let c, g_c = TcComm.lcomp_comp lc in - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print4 "Weakened from %s to %s\nStrengthening %s with guard %s\n" (N.term_to_string env lc.res_typ) (N.term_to_string env t) @@ -2738,7 +2750,7 @@ let weaken_result_typ env (e:term) (lc:lcomp) (t:typ) (use_eq:bool) : term * lco //AR: M_M bind let c = bind e.pos env (Some e) (TcComm.lcomp_of_comp c) (Some x, eq_ret) in let c, g_lc = TcComm.lcomp_comp c in - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print1 "Strengthened to %s\n" (Normalize.comp_to_string env c); c, Env.conj_guards [g_c; gret; g_lc] end @@ -2795,7 +2807,7 @@ let norm_reify (env:Env.env) (steps:Env.steps) (t:S.term) : S.term = let t' = N.normalize ([Env.Beta; Env.Reify; Env.Eager_unfolding; Env.EraseUniverses; Env.AllowUnboundUniverses; Env.Exclude Env.Zeta]@steps) env t in - if Env.debug env <| Options.Other "SMTEncodingReify" + if !dbg_SMTEncodingReify then BU.print2 "Reified body %s \nto %s\n" (Print.term_to_string t) (Print.term_to_string t') ; @@ -2828,7 +2840,7 @@ let maybe_instantiate (env:Env.env) e t = if not env.instantiate_imp then e, torig, Env.trivial_guard else begin - if Env.debug env Options.High then + if Debug.high () then BU.print3 "maybe_instantiate: starting check for (%s) of type (%s), expected type is %s\n" (show e) (show t) (show (Env.expected_typ env)); (* Similar to U.arrow_formals, but makes sure to unfold @@ -2883,7 +2895,7 @@ let maybe_instantiate (env:Env.env) e t = | _, ({binder_bv=x; binder_qual=Some (Implicit _);binder_attrs=[]})::rest -> let t = SS.subst subst x.sort in let v, _, g = new_implicit_var "Instantiation of implicit argument" e.pos env t in - if Env.debug env Options.High then + if Debug.high () then BU.print1 "maybe_instantiate: Instantiating implicit with %s\n" (show v); let subst = NT(x, v)::subst in let aq = U.aqual_of_binder (List.hd bs) in @@ -2912,7 +2924,7 @@ let maybe_instantiate (env:Env.env) e t = let v, _, g = Env.new_implicit_var_aux msg e.pos env t Strict (Some meta_t) in - if Env.debug env Options.High then + if Debug.high () then BU.print1 "maybe_instantiate: Instantiating meta argument with %s\n" (show v); let subst = NT(x, v)::subst in let aq = U.aqual_of_binder (List.hd bs) in @@ -2972,14 +2984,14 @@ let check_has_type_maybe_coerce env (e:term) (lc:lcomp) (t2:typ) use_eq : term * let env = Env.set_range env e.pos in let e, lc, g_c = maybe_coerce_lc env e lc t2 in let g = check_has_type env e lc.res_typ t2 use_eq in - if debug env <| Options.Other "Rel" then + if !dbg_Rel then BU.print1 "Applied guard is %s\n" <| guard_to_string env g; e, lc, (Env.conj_guard g g_c) ///////////////////////////////////////////////////////////////////////////////// let check_top_level env g lc : (bool * comp) = Errors.with_ctx "While checking for top-level effects" (fun () -> - if debug env Options.Medium then + if Debug.medium () then BU.print1 "check_top_level, lc = %s\n" (TcComm.lcomp_to_string lc); let discharge g = force_trivial_guard env g; @@ -3036,7 +3048,7 @@ let check_top_level env g lc : (bool * comp) = (c_eff |> Ident.string_of_lid)) (Env.get_range env) | Some (bs, _) -> - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in // // Typechecking of effect abbreviation ensures that there is at least // one return type argument, so the following a::bs is ok @@ -3079,7 +3091,7 @@ let check_top_level env g lc : (bool * comp) = |> S.mk_Comp |> Normalize.normalize_comp steps env in let ct, vc, g_pre = check_trivial_precondition_wp env c in - if Env.debug env <| Options.Other "Simplification" + if !dbg_Simplification then BU.print1 "top-level VC: %s\n" (Print.term_to_string vc); discharge (Env.conj_guard g (Env.conj_guard g_c g_pre)), ct |> S.mk_Comp ) @@ -3208,7 +3220,7 @@ let must_erase_for_extraction (g:env) (t:typ) = Env.Unascribe] env t in // debug g (fun () -> BU.print1 "aux %s\n" (Print.term_to_string t)); let res = Env.non_informative env t || descend env t in - if Env.debug env <| Options.Other "Extraction" + if !dbg_Extraction then BU.print2 "must_erase=%s: %s\n" (if res then "true" else "false") (Print.term_to_string t); res in @@ -3224,7 +3236,7 @@ let fresh_effect_repr env r eff_name signature_ts repr_ts_opt u a_tm = let _, signature = Env.inst_tscheme signature_ts in - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in (* * We go through the binders in the signature a -> bs @@ -3307,7 +3319,7 @@ let substitutive_indexed_lift_substs (env:env) : list subst_elt & guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in let bs, subst = let a_b::bs = bs in @@ -3341,7 +3353,7 @@ let ad_hoc_indexed_lift_substs (env:env) : list subst_elt & guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in let lift_t_shape_error s = BU.format2 "Lift %s has unexpected shape, reason: %s" @@ -3383,7 +3395,7 @@ let ad_hoc_indexed_lift_substs (env:env) let lift_tf_layered_effect (tgt:lident) (lift_ts:tscheme) (kind:S.indexed_effect_combinator_kind) env (c:comp) : comp * guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in if debug then BU.print2 "Lifting indexed comp %s to %s {\n" @@ -3417,8 +3429,8 @@ let lift_tf_layered_effect (tgt:lident) (lift_ts:tscheme) (kind:S.indexed_effect let u, wp = List.hd lift_ct.comp_univs, fst (List.hd lift_ct.effect_args) in Env.pure_precondition_for_trivial_post env u lift_ct.result_typ wp Range.dummyRange in - if Env.debug env <| Options.Other "LayeredEffects" && - Env.debug env <| Options.Extreme + if !dbg_LayeredEffects && + Debug.extreme () then BU.print1 "Guard for lift is: %s" (Print.term_to_string fml); let c = mk_Comp ({ From 77a0682d49d8aa35f47aea3d26acd0646802dafc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 27 Apr 2024 11:26:47 -0700 Subject: [PATCH 140/239] Options: implement --list_debug_keys --- src/basic/FStar.Options.fst | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/src/basic/FStar.Options.fst b/src/basic/FStar.Options.fst index 0b93912fa1d..1a26ccd9311 100644 --- a/src/basic/FStar.Options.fst +++ b/src/basic/FStar.Options.fst @@ -478,6 +478,10 @@ let display_version () = Util.print_string (Util.format5 "F* %s\nplatform=%s\ncompiler=%s\ndate=%s\ncommit=%s\n" !_version !_platform !_compiler !_date !_commit) +let display_debug_keys () = + let keys = Debug.list_all_toggles () in + keys |> List.sortWith String.compare |> List.iter (fun s -> Util.print_string (s ^ "\n")) + let display_usage_aux specs = let open FStar.Pprint in let open FStar.Errors.Msg in @@ -1418,7 +1422,13 @@ let rec specs_with_types warn_unsafe : list (char * string * opt_type * Pprint.d "help", WithSideEffect ((fun _ -> display_usage_aux (specs warn_unsafe); exit 0), (Const (Bool true))), - text "Display this information") + text "Display this information"); + + ( noshort, + "list_debug_keys", + WithSideEffect ((fun _ -> display_debug_keys(); exit 0), + (Const (Bool true))), + text "List all debug keys and exit"); ] and specs (warn_unsafe:bool) : list (FStar.Getopt.opt & Pprint.document) = From 54cf68bcb6835a1db2d961498b15a9d22ab48908 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 27 Apr 2024 12:41:26 -0700 Subject: [PATCH 141/239] Updating debug flags in tests/examples --- .completion/fish/fstar.exe.fish | 3 +-- examples/dm4free/README.md | 2 +- examples/dm4free/old/StExn.Handle.fst | 1 - examples/dm4free/old/intST.fst | 2 +- examples/native_tactics/Imp.Fun.Driver.fst | 2 +- examples/native_tactics/Imp.Fun.DriverNBE.fst | 2 +- examples/native_tactics/Imp.Fun.fst | 4 ++-- examples/native_tactics/Imp.List.Driver.fst | 2 +- examples/native_tactics/Imp.List.DriverNBE.fst | 2 +- examples/native_tactics/Imp.List.fst | 2 +- examples/native_tactics/Makefile | 2 +- examples/native_tactics/Registers.Imp.fst | 4 ++-- examples/tactics/Imp.fst | 2 +- .../micro-benchmarks/rewriteEqualityImplications.fst | 2 +- tests/bug-reports/Bug2478.fst | 4 ++-- tests/bug-reports/Bug3185.fst | 2 +- tests/bug-reports/Bug575.fst | 2 +- tests/bug-reports/UnificationCrash.fst | 2 +- tests/error-messages/QuickTestNBE.fst | 2 +- tests/micro-benchmarks/CoreEqualityGuard.fst | 4 ++-- tests/micro-benchmarks/CoreGeneralization.fst | 2 +- tests/micro-benchmarks/CoreUnivs.fst | 2 +- tests/micro-benchmarks/Test.NBE.fst | 2 +- tests/micro-benchmarks/Test.QuickCode.fst | 10 +++++----- tests/typeclasses/Bug3130.fst | 2 +- tests/vale/X64.Vale.StrongPost_i.fsti | 2 +- ulib/FStar.Stubs.Tactics.V1.Builtins.fsti | 2 +- ulib/FStar.Stubs.Tactics.V2.Builtins.fsti | 2 +- ulib/FStar.Tactics.V1.Derived.fst | 3 +-- ulib/FStar.Tactics.V2.Derived.fst | 3 +-- 30 files changed, 37 insertions(+), 41 deletions(-) diff --git a/.completion/fish/fstar.exe.fish b/.completion/fish/fstar.exe.fish index 7218d1ada12..eb9f58d5ee2 100644 --- a/.completion/fish/fstar.exe.fish +++ b/.completion/fish/fstar.exe.fish @@ -12,8 +12,7 @@ complete -c fstar.exe -l print_cache_version --description "Print the version fo complete -c fstar.exe -l cmi --description "Inline across module interfaces during extraction (aka. cross-module inlining)" complete -c fstar.exe -l codegen -r --description "Generate code for further compilation to executable code, or build a compiler plugin" complete -c fstar.exe -l codegen-lib --description "namespace External runtime library (i.e. M.N.x extracts to M.N.X instead of M_N.x)" -complete -c fstar.exe -l debug --description "module_name Print lots of debugging information while checking module" -complete -c fstar.exe -l debug_level -r --description "Control the verbosity of debugging info" +complete -c fstar.exe -l debug -r --description "Control the verbosity of debugging info" complete -c fstar.exe -l defensive -r --description "Enable several internal sanity checks, useful to track bugs and report issues." complete -c fstar.exe -l dep -r --description "Output the transitive closure of the full dependency graph in three formats:" complete -c fstar.exe -l detail_errors --description "Emit a detailed error report by asking the SMT solver many queries; will take longer" diff --git a/examples/dm4free/README.md b/examples/dm4free/README.md index 66706fd0cee..4b677a3bcd9 100644 --- a/examples/dm4free/README.md +++ b/examples/dm4free/README.md @@ -23,7 +23,7 @@ To see more debug output related to the DMFF elaboration and star transformations: ``` -fstar.exe --trace_error --debug_level ED --debug FStar.DM4F.IntST FStar.DM4F.IntST.fst --prn --print_implicits --print_universes --print_bound_var_types +fstar.exe --trace_error --debug ED FStar.DM4F.IntST.fst --prn --print_implicits --print_universes --print_bound_var_types ``` Current status: diff --git a/examples/dm4free/old/StExn.Handle.fst b/examples/dm4free/old/StExn.Handle.fst index b3eb0a87601..872206639cc 100644 --- a/examples/dm4free/old/StExn.Handle.fst +++ b/examples/dm4free/old/StExn.Handle.fst @@ -197,7 +197,6 @@ val handle: #a:Type0 -> #wp:wp a -> $f:(unit -> StateExn a wp) (* match x with *) (* | None -> False *) (* | Some z -> (ens h0 None h1 /\ z=def) \/ ens h0 x h1) *) -(* #set-options "--debug StExn.Handle --debug_level HACK!" *) (* let handle2 #a #req #ens f def = *) (* StateExn.reflect (fun h0 -> *) (* match reify (f ()) h0 with *) diff --git a/examples/dm4free/old/intST.fst b/examples/dm4free/old/intST.fst index be6ffef9888..75ac0fd1d8f 100644 --- a/examples/dm4free/old/intST.fst +++ b/examples/dm4free/old/intST.fst @@ -105,7 +105,7 @@ let put_unfolded (n: int): (n0: int -> PURE (unit * int) (fun post -> post ((), let put_cps_type = n:int -> Tot (repr unit (fun n0 post -> post ((), n))) let put_cps_type_unfolded = n:int -> Tot (n0: int -> PURE (unit * int) (fun post -> post ((), n))) -(* #reset-options "--debug NatST --debug_level SMTEncoding" *) +(* #reset-options "--debug SMTEncoding" *) reifiable reflectable new_effect { STATE : a:Type -> wp:wp a -> Effect diff --git a/examples/native_tactics/Imp.Fun.Driver.fst b/examples/native_tactics/Imp.Fun.Driver.fst index 08a3181b755..b8082cafbe2 100644 --- a/examples/native_tactics/Imp.Fun.Driver.fst +++ b/examples/native_tactics/Imp.Fun.Driver.fst @@ -47,6 +47,6 @@ let normal #a (e:a) = let norm_assert (p:Type) : Lemma (requires (normal p)) (ensures True) = () -#set-options "--debug Imp.Fun.Driver --debug_level print_normalized_terms --admit_smt_queries true" +#set-options "--debug print_normalized_terms --admit_smt_queries true" // let _ = norm_assert (forall (x:int) rm. R.sel (eval' (Seq [Const x (reg 0)]) rm) 0 == x) // eval' (Seq [Const x (reg 0)]) rm == rm) let _ = norm_assert (forall x y. equiv_norm (long_zero x) (long_zero y)) diff --git a/examples/native_tactics/Imp.Fun.DriverNBE.fst b/examples/native_tactics/Imp.Fun.DriverNBE.fst index 59a713b788e..269eda04b67 100644 --- a/examples/native_tactics/Imp.Fun.DriverNBE.fst +++ b/examples/native_tactics/Imp.Fun.DriverNBE.fst @@ -48,6 +48,6 @@ let normal #a (e:a) = let norm_assert (p:Type) : Lemma (requires (normal p)) (ensures True) = () -#set-options "--debug Imp.Fun.DriverNBE --debug_level print_normalized_terms --admit_smt_queries true" +#set-options "--debug print_normalized_terms --admit_smt_queries true" // let _ = norm_assert (forall (x:int) rm. R.sel (eval' (Seq [Const x (reg 0)]) rm) 0 == x) // eval' (Seq [Const x (reg 0)]) rm == rm) let _ = norm_assert (forall x y. equiv_norm (long_zero x) (long_zero y)) diff --git a/examples/native_tactics/Imp.Fun.fst b/examples/native_tactics/Imp.Fun.fst index 8ac62622947..7fa34d9683d 100644 --- a/examples/native_tactics/Imp.Fun.fst +++ b/examples/native_tactics/Imp.Fun.fst @@ -14,7 +14,7 @@ limitations under the License. *) module Imp.Fun -//#set-options "--debug Imp --debug_level SMTQuery" +//#set-options "--debug SMTQuery" open FStar.Mul module R = Registers.Fun @@ -167,7 +167,7 @@ let normal #a (e:a) = let norm_assert (p:Type) : Lemma (requires (normal p)) (ensures True) = () -#set-options "--debug Registers.Imp --debug_level print_normalized_terms --admit_smt_queries true" +#set-options "--debug print_normalized_terms --admit_smt_queries true" // let _ = norm_assert (forall (x:int) rm. R.sel (eval' (Seq [Const x (reg 0)]) rm) 0 == x) // eval' (Seq [Const x (reg 0)]) rm == rm) let _ = norm_assert (forall x y. equiv_norm (long_zero x) (long_zero y)) // let _ = norm_assert (forall x y. equiv_norm (long_zero x) (long_zero y)) diff --git a/examples/native_tactics/Imp.List.Driver.fst b/examples/native_tactics/Imp.List.Driver.fst index e62325b5648..278322e153e 100644 --- a/examples/native_tactics/Imp.List.Driver.fst +++ b/examples/native_tactics/Imp.List.Driver.fst @@ -47,6 +47,6 @@ let normal #a (e:a) = let norm_assert (p:Type) : Lemma (requires (normal p)) (ensures True) = () -#set-options "--debug Imp.List.Driver --debug_level print_normalized_terms --admit_smt_queries true" +#set-options "--debug print_normalized_terms --admit_smt_queries true" // let _ = norm_assert (forall (x:int) rm. R.sel (eval' (Seq [Const x (reg 0)]) rm) 0 == x) // eval' (Seq [Const x (reg 0)]) rm == rm) let _ = norm_assert (forall x y. equiv_norm (long_zero x) (long_zero y)) diff --git a/examples/native_tactics/Imp.List.DriverNBE.fst b/examples/native_tactics/Imp.List.DriverNBE.fst index f1cff409fcc..23cce7a26a1 100644 --- a/examples/native_tactics/Imp.List.DriverNBE.fst +++ b/examples/native_tactics/Imp.List.DriverNBE.fst @@ -48,5 +48,5 @@ let normal #a (e:a) = let norm_assert (p:Type) : Lemma (requires (normal p)) (ensures True) = () -#set-options "--debug Imp.List.DriverNBE --debug_level print_normalized_terms --admit_smt_queries true" +#set-options "--debug print_normalized_terms --admit_smt_queries true" let _ = norm_assert (forall x y. equiv_norm (long_zero x) (long_zero y)) diff --git a/examples/native_tactics/Imp.List.fst b/examples/native_tactics/Imp.List.fst index 894ea266e3e..b348ac35fed 100644 --- a/examples/native_tactics/Imp.List.fst +++ b/examples/native_tactics/Imp.List.fst @@ -14,7 +14,7 @@ limitations under the License. *) module Imp.List -//#set-options "--debug Imp --debug_level SMTQuery" +//#set-options "--debug SMTQuery" open FStar.Mul module R = Registers.List diff --git a/examples/native_tactics/Makefile b/examples/native_tactics/Makefile index d88329ad727..1d3735ed423 100644 --- a/examples/native_tactics/Makefile +++ b/examples/native_tactics/Makefile @@ -54,7 +54,7 @@ all: $(addsuffix .sep.test, $(TAC_MODULES)) $(addsuffix .test, $(ALL)) touch $@ %.sep.test: %.fst %.ml - $(FSTAR) $*.Test.fst --load $* --debug $* --debug_level tactics + $(FSTAR) $*.Test.fst --load $* touch $@ %.ml: %.fst diff --git a/examples/native_tactics/Registers.Imp.fst b/examples/native_tactics/Registers.Imp.fst index 64ff3bfe2d8..eab1b267b7a 100644 --- a/examples/native_tactics/Registers.Imp.fst +++ b/examples/native_tactics/Registers.Imp.fst @@ -14,7 +14,7 @@ limitations under the License. *) module Registers.Imp -//#set-options "--debug Imp --debug_level SMTQuery" +//#set-options "--debug SMTQuery" open FStar.Mul module R = Registers.List @@ -167,7 +167,7 @@ let normal #a (e:a) = let norm_assert (p:Type) : Lemma (requires (normal p)) (ensures True) = () -#set-options "--debug Registers.Imp --debug_level print_normalized_terms --admit_smt_queries true" +#set-options "--debug print_normalized_terms --admit_smt_queries true" // let _ = norm_assert (forall (x:int) rm. R.sel (eval' (Seq [Const x (reg 0)]) rm) 0 == x) // eval' (Seq [Const x (reg 0)]) rm == rm) let _ = norm_assert (forall x y. equiv_norm (long_zero x) (long_zero y)) // let _ = norm_assert (forall x y. equiv_norm (long_zero x) (long_zero y)) diff --git a/examples/tactics/Imp.fst b/examples/tactics/Imp.fst index b9f8075987e..8cd73ea198e 100644 --- a/examples/tactics/Imp.fst +++ b/examples/tactics/Imp.fst @@ -15,7 +15,7 @@ *) module Imp -//#set-options "--debug Imp --debug_level SMTQuery" +//#set-options "--debug SMTQuery" open FStar.Mul open FStar.Tactics.V2 diff --git a/examples/tactics/micro-benchmarks/rewriteEqualityImplications.fst b/examples/tactics/micro-benchmarks/rewriteEqualityImplications.fst index 0ad83b55821..2ff62b68687 100644 --- a/examples/tactics/micro-benchmarks/rewriteEqualityImplications.fst +++ b/examples/tactics/micro-benchmarks/rewriteEqualityImplications.fst @@ -14,7 +14,7 @@ limitations under the License. *) (* Here's the incantation I use to check this file: *) -(* $ fstar rewriteEqualityImplications.fst --debug RewriteEqualityImplications --debug_level Low | grep "\(Got goal\)\|Checking top-level decl let" *) +(* $ fstar rewriteEqualityImplications.fst --debug Low | grep "\(Got goal\)\|Checking top-level decl let" *) (* Notice the "Got goal" output, in particular---that's the result of preprocessing the VC for each top-level term. *) (* Each term results in 0 or more queries that get sent to Z3 *) module RewriteEqualityImplications diff --git a/tests/bug-reports/Bug2478.fst b/tests/bug-reports/Bug2478.fst index 169562c4942..28015061902 100755 --- a/tests/bug-reports/Bug2478.fst +++ b/tests/bug-reports/Bug2478.fst @@ -28,7 +28,7 @@ let key0 (bytes:Type0) (#pf: bytes_like bytes) = bytes // assume // val ps_key0: #bytes:Type0 -> (#pf: bytes_like bytes ) -> test_type bytes (key0 bytes #pf) -// //#push-options "--debug Bug2478 --debug_level Rel,RelCheck,Tac --lax" +// //#push-options "--debug Rel,RelCheck,Tac --lax" // let ps_pair3_0 (bytes:Type0) (#pf: bytes_like bytes ): (test_type bytes (x0:bytes & (x1:bytes & bytes))) = // ps_key0 #_ #_;; // ps_key0 ;; @@ -39,7 +39,7 @@ let key (bytes:Type0) {|bytes_like bytes|} = bytes assume val ps_key: #bytes:Type0 -> {|bytes_like bytes|} -> test_type bytes (key bytes) -// #push-options "--debug Bug2478 --debug_level Rel,RelCheck,Tac --lax" +// #push-options "--debug Rel,RelCheck,Tac --lax" let ps_pair3 (bytes:Type0) {| pf: bytes_like bytes|}: (test_type bytes (x0:bytes & (x1:bytes & bytes))) = ps_key #_ #_;; ps_key;; diff --git a/tests/bug-reports/Bug3185.fst b/tests/bug-reports/Bug3185.fst index c3958930f13..e6b36678030 100644 --- a/tests/bug-reports/Bug3185.fst +++ b/tests/bug-reports/Bug3185.fst @@ -3,7 +3,7 @@ module Bug3185 module FT = FStar.Tactics.V2 #push-options "--print_bound_var_types --print_full_names" -// #push-options "--debug_level NBE --debug Test_NbeIllTyped" +// #push-options "--debug NBE" let test_normalise (): unit = assert (forall (i: int). op_LessThanOrEqual == op_LessThanOrEqual) diff --git a/tests/bug-reports/Bug575.fst b/tests/bug-reports/Bug575.fst index 62fc18e6e1b..a6b354f2d23 100644 --- a/tests/bug-reports/Bug575.fst +++ b/tests/bug-reports/Bug575.fst @@ -26,7 +26,7 @@ noeq type multi (r:relation) : int -> Type0 = // Because the dependent pattern matching here goes wrong // Probably because the abbreviation isn't unfolded at the right time -//#set-options "--debug Bug575 --debug_level Rel --debug_level RelCheck" +//#set-options "--debug Rel,RelCheck" let is_Multi_step (r:relation) (x:int) (projectee : multi r x) = match projectee with | Multi_step y ry -> true diff --git a/tests/bug-reports/UnificationCrash.fst b/tests/bug-reports/UnificationCrash.fst index 3f6ec7a6ede..fe5f5b8e836 100644 --- a/tests/bug-reports/UnificationCrash.fst +++ b/tests/bug-reports/UnificationCrash.fst @@ -16,5 +16,5 @@ module UnificationCrash type tree (a:Type0) = | Tree : a -> tree a assume val tree_merge : #a:Type -> cmp:(a -> a -> bool) -> h1:tree a -> tree a -(* #set-options "--debug Crash --debug_level Rel --debug_level RelCheck --debug_level Extreme --debug_level Gen" *) +(* #set-options "--debug Rel,RelCheck,Extreme,Gen" *) let tree_insert cmp h = tree_merge cmp h diff --git a/tests/error-messages/QuickTestNBE.fst b/tests/error-messages/QuickTestNBE.fst index c2c94cb687c..b47a932fe93 100755 --- a/tests/error-messages/QuickTestNBE.fst +++ b/tests/error-messages/QuickTestNBE.fst @@ -127,7 +127,7 @@ let va_qcode_Test2 : (quickCode unit) = ) #push-options "--print_expected_failures" -//#push-options "--debug QuickTestNBE --debug_level SMTQuery --ugly --print_implicits" +//#push-options "--debug SMTQuery --ugly --print_implicits" [@@expect_failure [19]] let va_lemma_Test2 (va_s0:vale_state) = wp_sound_code_norm diff --git a/tests/micro-benchmarks/CoreEqualityGuard.fst b/tests/micro-benchmarks/CoreEqualityGuard.fst index 5b4cd5bb0f8..fc8a5b8e2f6 100644 --- a/tests/micro-benchmarks/CoreEqualityGuard.fst +++ b/tests/micro-benchmarks/CoreEqualityGuard.fst @@ -11,14 +11,14 @@ val r_b (x:a) (y z:b x) : Type0 let dsnd #a (#b: a -> Type) (x: dtuple2 a b) : b (dfst x) = dsnd x -// #push-options "--debug CoreEqualityGuard --debug_level SMTQuery,Rel" +// #push-options "--debug SMTQuery,Rel" // let test (t1 t2 : dtuple2 a b) // (p: squash (dfst t1 == dfst t2)) // : b (dfst t1) // = dsnd t2 -#push-options "--debug CoreEqualityGuard --debug_level Core" +#push-options "--debug Core" let test (t1 t2 : dtuple2 a b) (p: (dfst t1 == dfst t2 /\ diff --git a/tests/micro-benchmarks/CoreGeneralization.fst b/tests/micro-benchmarks/CoreGeneralization.fst index 53a548158e4..f243f79e3bd 100644 --- a/tests/micro-benchmarks/CoreGeneralization.fst +++ b/tests/micro-benchmarks/CoreGeneralization.fst @@ -2,6 +2,6 @@ module CoreGeneralization let test (x:int) (#a:Type) (y:a) = y -#push-options "--debug CoreGeneralization --debug_level TwoPhases,Gen" +#push-options "--debug TwoPhases,Gen" let gen x = test x diff --git a/tests/micro-benchmarks/CoreUnivs.fst b/tests/micro-benchmarks/CoreUnivs.fst index b336eafeb4e..190af65d2c4 100644 --- a/tests/micro-benchmarks/CoreUnivs.fst +++ b/tests/micro-benchmarks/CoreUnivs.fst @@ -4,6 +4,6 @@ val embedding (a:Type u#a) : Type u#a val e_div_arrow (#a:Type u#a) (#b:Type u#b) (f:a -> Dv b) : embedding u#a (a -> Dv b) -(* #push-options "--debug CoreUnivs --debug_level Extreme,Rel,ExplainRel,Core" *) +(* #push-options "--debug Extreme,Rel,ExplainRel,Core" *) let e_div_arrow (#a:Type u#a) (#b:Type u#b) (f:a -> Dv b) = admit() diff --git a/tests/micro-benchmarks/Test.NBE.fst b/tests/micro-benchmarks/Test.NBE.fst index ca8413b8aa2..19e0c131bb0 100644 --- a/tests/micro-benchmarks/Test.NBE.fst +++ b/tests/micro-benchmarks/Test.NBE.fst @@ -47,4 +47,4 @@ let test3 = assert (norm [primops; delta; zeta; nbe] (List.append [1;2;3;4;5;6;7] [8;9]) = [1;2;3;4;5;6;7;8;9]) -#set-options "--debug_level NBE --debug Test.NBE --max_fuel 0" +// #set-options "--debug NBE --max_fuel 0" diff --git a/tests/micro-benchmarks/Test.QuickCode.fst b/tests/micro-benchmarks/Test.QuickCode.fst index 6b2b8ecaa32..ae9f505ed7c 100644 --- a/tests/micro-benchmarks/Test.QuickCode.fst +++ b/tests/micro-benchmarks/Test.QuickCode.fst @@ -35,7 +35,7 @@ let sel (r:reg_file) (x:int) = r x let upd (r:reg_file) (x:int) (v:int) = fun y -> if x=y then v else sel r y -//#set-options "--debug_level print_normalized_terms --debug_level NBE" +//#set-options "--debug print_normalized_terms,NBE" // let test = // assert (norm_simple (if 0 = 0 then true else false) == true) @@ -50,8 +50,8 @@ let upd (r:reg_file) (x:int) (v:int) = fun y -> if x=y then v else sel r y //////////////////////////////////////////////////////////////////////////////// //#reset-options "--z3rlimit 10 --lax" -#set-options "--debug_level NBE" -//#set-options "--debug_level print_normalized_terms --debug_level NBE" +#set-options "--debug NBE" +//#set-options "--debug print_normalized_terms,NBE" noeq type state = { ok: bool; @@ -95,8 +95,8 @@ let wp_compute_ghash_incremental (x:int) (s0:state) (k:(state -> Type0)) : Type0 let sM = up_xmm 6 x (up_xmm 5 x (up_xmm 4 x sM)) in (k sM) -//#reset-options "--z3rlimit 10 --debug_level NBE --debug_level SMTQuery" -#reset-options "--z3rlimit 10 --admit_smt_queries true --debug_level SMTQuery" +//#reset-options "--z3rlimit 10 --debug NBE --debug SMTQuery" +#reset-options "--z3rlimit 10 --admit_smt_queries true --debug SMTQuery" let lemma_gcm_core (s0:state) (x:int) : Lemma True = let k s = diff --git a/tests/typeclasses/Bug3130.fst b/tests/typeclasses/Bug3130.fst index b1680a3ca83..12363926fad 100644 --- a/tests/typeclasses/Bug3130.fst +++ b/tests/typeclasses/Bug3130.fst @@ -22,7 +22,7 @@ assume val truc: open FStar.Tactics.Typeclasses -#set-options "--debug_level Low" +#set-options "--debug Low" noeq type machin (a:Type) (d : typeclass2 bytes #solve a) (content:a) = { diff --git a/tests/vale/X64.Vale.StrongPost_i.fsti b/tests/vale/X64.Vale.StrongPost_i.fsti index 30ad39194b3..70033dea52c 100644 --- a/tests/vale/X64.Vale.StrongPost_i.fsti +++ b/tests/vale/X64.Vale.StrongPost_i.fsti @@ -224,7 +224,7 @@ let va_lemma_weakest_pre_norm_wp (inss:list ins) (s0:state) (sN:state) : pure_wp [@"uninterpreted_by_smt"] val va_lemma_weakest_pre_norm (inss:list ins) (s0:state) (sN:state) : PURE unit (va_lemma_weakest_pre_norm_wp inss s0 sN) -(* #reset-options "--log_queries --debug X64.Vale.StrongPost_i --debug_level print_normalized_terms" *) +(* #reset-options "--log_queries --debug X64.Vale.StrongPost_i --debug print_normalized_terms" *) // let test_lemma (s0:state) (sN:state) = // assume (s0.ok); // // assume (Map.contains s0.mem (s0.regs Rsi)); diff --git a/ulib/FStar.Stubs.Tactics.V1.Builtins.fsti b/ulib/FStar.Stubs.Tactics.V1.Builtins.fsti index 637a09176a4..40a731d1f4d 100644 --- a/ulib/FStar.Stubs.Tactics.V1.Builtins.fsti +++ b/ulib/FStar.Stubs.Tactics.V1.Builtins.fsti @@ -189,7 +189,7 @@ of printing [str] on the compiler's standard output. *) val print : string -> Tac unit (** [debugging ()] returns true if the current module has the debug flag -on, i.e. when [--debug MyModule --debug_level Tac] was passed in. *) +on, i.e. when [--debug Tac] was passed in. *) val debugging : unit -> Tac bool (** Similar to [print], but will dump a text representation of the proofstate diff --git a/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti b/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti index 3ae34455fd4..c1bca5f7841 100644 --- a/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti +++ b/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti @@ -190,7 +190,7 @@ of printing [str] on the compiler's standard output. *) val print : string -> Tac unit (** [debugging ()] returns true if the current module has the debug flag -on, i.e. when [--debug MyModule --debug_level Tac] was passed in. *) +on, i.e. when [--debug Tac] was passed in. *) val debugging : unit -> Tac bool (** Similar to [print], but will dump a text representation of the proofstate diff --git a/ulib/FStar.Tactics.V1.Derived.fst b/ulib/FStar.Tactics.V1.Derived.fst index bc137ef3353..fb34d51dd8e 100644 --- a/ulib/FStar.Tactics.V1.Derived.fst +++ b/ulib/FStar.Tactics.V1.Derived.fst @@ -137,8 +137,7 @@ let qed () : Tac unit = | _ -> fail "qed: not done!" (** [debug str] is similar to [print str], but will only print the message -if the [--debug] option was given for the current module AND -[--debug_level Tac] is on. *) +if [--debug Tac] is on. *) let debug (m:string) : Tac unit = if debugging () then print m diff --git a/ulib/FStar.Tactics.V2.Derived.fst b/ulib/FStar.Tactics.V2.Derived.fst index 0b791d5cb6a..3d2aa25f38b 100644 --- a/ulib/FStar.Tactics.V2.Derived.fst +++ b/ulib/FStar.Tactics.V2.Derived.fst @@ -156,8 +156,7 @@ let qed () : Tac unit = | _ -> fail "qed: not done!" (** [debug str] is similar to [print str], but will only print the message -if the [--debug] option was given for the current module AND -[--debug_level Tac] is on. *) +if [--debug Tac] is on. *) let debug (m:string) : Tac unit = if debugging () then print m From 431e8f6a17ada9a4c6763da69e485188fd5e91b9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 29 Apr 2024 08:33:43 -0700 Subject: [PATCH 142/239] snap --- .../fstar-lib/generated/FStar_CheckedFiles.ml | 30 +- .../generated/FStar_Compiler_Debug.ml | 91 + ocaml/fstar-lib/generated/FStar_Errors.ml | 6 +- .../generated/FStar_Extraction_ML_Modul.ml | 29 +- .../generated/FStar_Extraction_ML_RegEmb.ml | 6 +- .../generated/FStar_Extraction_ML_Term.ml | 11 +- .../generated/FStar_Extraction_ML_UEnv.ml | 5 +- .../generated/FStar_Interactive_Ide.ml | 15 +- .../FStar_Interactive_Incremental.ml | 2 +- .../generated/FStar_Interactive_Legacy.ml | 2 +- ocaml/fstar-lib/generated/FStar_Main.ml | 2 +- ocaml/fstar-lib/generated/FStar_Options.ml | 139 +- ocaml/fstar-lib/generated/FStar_Parser_Dep.ml | 38 +- .../generated/FStar_SMTEncoding_Encode.ml | 110 +- .../generated/FStar_SMTEncoding_EncodeTerm.ml | 53 +- .../generated/FStar_SMTEncoding_Env.ml | 6 +- .../generated/FStar_SMTEncoding_Solver.ml | 4 +- .../generated/FStar_SMTEncoding_Z3.ml | 4 +- .../generated/FStar_Syntax_Compress.ml | 4 +- .../generated/FStar_Tactics_Hooks.ml | 1858 ++++++++--------- .../generated/FStar_Tactics_Interpreter.ml | 21 +- .../generated/FStar_Tactics_Monad.ml | 30 +- .../generated/FStar_Tactics_Printing.ml | 7 +- .../generated/FStar_Tactics_V1_Basic.ml | 55 +- .../generated/FStar_Tactics_V1_Derived.ml | 1384 ++++++------ .../generated/FStar_Tactics_V2_Basic.ml | 73 +- .../generated/FStar_Tactics_V2_Derived.ml | 1294 ++++++------ .../generated/FStar_ToSyntax_ToSyntax.ml | 13 +- .../generated/FStar_TypeChecker_Cfg.ml | 117 +- .../generated/FStar_TypeChecker_Core.ml | 67 +- .../generated/FStar_TypeChecker_DMFF.ml | 39 +- .../generated/FStar_TypeChecker_Env.ml | 15 +- .../generated/FStar_TypeChecker_Generalize.ml | 37 +- .../generated/FStar_TypeChecker_NBE.ml | 14 +- .../generated/FStar_TypeChecker_Normalize.ml | 16 +- .../FStar_TypeChecker_PatternUtils.ml | 5 +- .../generated/FStar_TypeChecker_Positivity.ml | 13 +- .../generated/FStar_TypeChecker_Rel.ml | 462 ++-- .../generated/FStar_TypeChecker_Tc.ml | 197 +- .../generated/FStar_TypeChecker_TcEffect.ml | 137 +- .../FStar_TypeChecker_TcInductive.ml | 42 +- .../generated/FStar_TypeChecker_TcTerm.ml | 258 +-- .../generated/FStar_TypeChecker_Util.ml | 194 +- ocaml/fstar-lib/generated/FStar_Universal.ml | 5 +- .../fstar-tests/generated/FStar_Tests_Unif.ml | 183 +- 45 files changed, 3432 insertions(+), 3661 deletions(-) create mode 100644 ocaml/fstar-lib/generated/FStar_Compiler_Debug.ml diff --git a/ocaml/fstar-lib/generated/FStar_CheckedFiles.ml b/ocaml/fstar-lib/generated/FStar_CheckedFiles.ml index 729e546791b..767d4dff399 100644 --- a/ocaml/fstar-lib/generated/FStar_CheckedFiles.ml +++ b/ocaml/fstar-lib/generated/FStar_CheckedFiles.ml @@ -1,4 +1,6 @@ open Prims +let (dbg : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "CheckedFiles" let (cache_version_number : Prims.int) = (Prims.of_int (66)) type tc_result = { @@ -162,9 +164,7 @@ let (hash_dependences : FStar_Compiler_Util.format1 "hash_dependences::the interface checked file %s does not exist\n" iface in - ((let uu___2 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "CheckedFiles") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg in if uu___2 then FStar_Compiler_Util.print1 "%s\n" msg else ()); @@ -193,9 +193,7 @@ let (hash_dependences : FStar_Compiler_Util.format2 "For dependency %s, cache file %s is not loaded" fn2 cache_fn in - ((let uu___3 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "CheckedFiles") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg in if uu___3 then FStar_Compiler_Util.print1 "%s\n" msg else ()); @@ -223,9 +221,7 @@ let (hash_dependences : let (load_checked_file : Prims.string -> Prims.string -> cache_t) = fun fn -> fun checked_fn -> - (let uu___1 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "CheckedFiles") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg in if uu___1 then FStar_Compiler_Util.print1 "Trying to load checked file result %s\n" @@ -263,9 +259,7 @@ let (load_checked_file : Prims.string -> Prims.string -> cache_t) = FStar_Compiler_Util.digest_of_file fn in if x.digest <> current_digest then - ((let uu___5 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "CheckedFiles") in + ((let uu___5 = FStar_Compiler_Effect.op_Bang dbg in if uu___5 then FStar_Compiler_Util.print4 @@ -289,9 +283,7 @@ let (load_checked_file_with_tc_result : fun deps -> fun fn -> fun checked_fn -> - (let uu___1 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "CheckedFiles") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg in if uu___1 then FStar_Compiler_Util.print1 @@ -369,9 +361,7 @@ let (load_checked_file_with_tc_result : validate_iface_cache (); FStar_Pervasives.Inr tc_result1)) else - ((let uu___5 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "CheckedFiles") in + ((let uu___5 = FStar_Compiler_Effect.op_Bang dbg in if uu___5 then ((let uu___7 = @@ -490,9 +480,7 @@ let (load_module_from_cache : | FStar_Pervasives.Inl msg -> (fail msg cache_file; FStar_Pervasives_Native.None) | FStar_Pervasives.Inr tc_result1 -> - ((let uu___4 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "CheckedFiles") in + ((let uu___4 = FStar_Compiler_Effect.op_Bang dbg in if uu___4 then FStar_Compiler_Util.print1 diff --git a/ocaml/fstar-lib/generated/FStar_Compiler_Debug.ml b/ocaml/fstar-lib/generated/FStar_Compiler_Debug.ml new file mode 100644 index 00000000000..5263a316259 --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_Compiler_Debug.ml @@ -0,0 +1,91 @@ +open Prims +let (toggle_list : + (Prims.string * Prims.bool FStar_Compiler_Effect.ref) Prims.list + FStar_Compiler_Effect.ref) + = FStar_Compiler_Util.mk_ref [] +let (register_toggle : Prims.string -> Prims.bool FStar_Compiler_Effect.ref) + = + fun k -> + let r = FStar_Compiler_Util.mk_ref false in + (let uu___1 = + let uu___2 = FStar_Compiler_Effect.op_Bang toggle_list in (k, r) :: + uu___2 in + FStar_Compiler_Effect.op_Colon_Equals toggle_list uu___1); + r +let (get_toggle : Prims.string -> Prims.bool FStar_Compiler_Effect.ref) = + fun k -> + let uu___ = + let uu___1 = FStar_Compiler_Effect.op_Bang toggle_list in + FStar_Compiler_List.tryFind + (fun uu___2 -> match uu___2 with | (k', uu___3) -> k = k') uu___1 in + match uu___ with + | FStar_Pervasives_Native.Some (uu___1, r) -> r + | FStar_Pervasives_Native.None -> register_toggle k +let (list_all_toggles : unit -> Prims.string Prims.list) = + fun uu___ -> + let uu___1 = FStar_Compiler_Effect.op_Bang toggle_list in + FStar_Compiler_List.map FStar_Pervasives_Native.fst uu___1 +let (anyref : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Util.mk_ref false +let (any : unit -> Prims.bool) = + fun uu___ -> FStar_Compiler_Effect.op_Bang anyref +let (enable : unit -> unit) = + fun uu___ -> FStar_Compiler_Effect.op_Colon_Equals anyref true +let (dbg_level : Prims.int FStar_Compiler_Effect.ref) = + FStar_Compiler_Util.mk_ref Prims.int_zero +let (low : unit -> Prims.bool) = + fun uu___ -> + let uu___1 = FStar_Compiler_Effect.op_Bang dbg_level in + uu___1 >= Prims.int_one +let (medium : unit -> Prims.bool) = + fun uu___ -> + let uu___1 = FStar_Compiler_Effect.op_Bang dbg_level in + uu___1 >= (Prims.of_int (2)) +let (high : unit -> Prims.bool) = + fun uu___ -> + let uu___1 = FStar_Compiler_Effect.op_Bang dbg_level in + uu___1 >= (Prims.of_int (3)) +let (extreme : unit -> Prims.bool) = + fun uu___ -> + let uu___1 = FStar_Compiler_Effect.op_Bang dbg_level in + uu___1 >= (Prims.of_int (4)) +let (set_level_low : unit -> unit) = + fun uu___ -> FStar_Compiler_Effect.op_Colon_Equals dbg_level Prims.int_one +let (set_level_medium : unit -> unit) = + fun uu___ -> + FStar_Compiler_Effect.op_Colon_Equals dbg_level (Prims.of_int (2)) +let (set_level_high : unit -> unit) = + fun uu___ -> + FStar_Compiler_Effect.op_Colon_Equals dbg_level (Prims.of_int (3)) +let (set_level_extreme : unit -> unit) = + fun uu___ -> + FStar_Compiler_Effect.op_Colon_Equals dbg_level (Prims.of_int (4)) +let (enable_toggles : Prims.string Prims.list -> unit) = + fun keys -> + if Prims.uu___is_Cons keys then enable () else (); + FStar_Compiler_List.iter + (fun k -> + if k = "Low" + then set_level_low () + else + if k = "Medium" + then set_level_medium () + else + if k = "High" + then set_level_high () + else + if k = "Extreme" + then set_level_extreme () + else + (let t = get_toggle k in + FStar_Compiler_Effect.op_Colon_Equals t true)) keys +let (disable_all : unit -> unit) = + fun uu___ -> + FStar_Compiler_Effect.op_Colon_Equals anyref false; + FStar_Compiler_Effect.op_Colon_Equals dbg_level Prims.int_zero; + (let uu___3 = FStar_Compiler_Effect.op_Bang toggle_list in + FStar_Compiler_List.iter + (fun uu___4 -> + match uu___4 with + | (uu___5, r) -> FStar_Compiler_Effect.op_Colon_Equals r false) + uu___3) \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Errors.ml b/ocaml/fstar-lib/generated/FStar_Errors.ml index 5357dc35905..b14d51365f4 100644 --- a/ocaml/fstar-lib/generated/FStar_Errors.ml +++ b/ocaml/fstar-lib/generated/FStar_Errors.ml @@ -483,7 +483,7 @@ let (mk_default_handler : Prims.bool -> error_handler) = else (); (match e.issue_level with | EInfo -> print_issue e - | uu___2 when print && (FStar_Options.debug_any ()) -> print_issue e + | uu___2 when print && (FStar_Compiler_Debug.any ()) -> print_issue e | uu___2 -> let uu___3 = let uu___4 = FStar_Compiler_Effect.op_Bang issues in e :: uu___4 in @@ -649,7 +649,7 @@ let (diag_doc : = fun r -> fun msg -> - let uu___ = FStar_Options.debug_any () in + let uu___ = FStar_Compiler_Debug.any () in if uu___ then let msg1 = maybe_add_backtrace msg in @@ -663,7 +663,7 @@ let (diag : FStar_Compiler_Range_Type.range -> Prims.string -> unit) = fun msg -> let uu___ = FStar_Errors_Msg.mkmsg msg in diag_doc r uu___ let (diag0 : Prims.string -> unit) = fun msg -> - let uu___ = FStar_Options.debug_any () in + let uu___ = FStar_Compiler_Debug.any () in if uu___ then let uu___1 = diff --git a/ocaml/fstar-lib/generated/FStar_Extraction_ML_Modul.ml b/ocaml/fstar-lib/generated/FStar_Extraction_ML_Modul.ml index 58dcb7cf5c0..5f9ac7c432e 100644 --- a/ocaml/fstar-lib/generated/FStar_Extraction_ML_Modul.ml +++ b/ocaml/fstar-lib/generated/FStar_Extraction_ML_Modul.ml @@ -1,4 +1,6 @@ open Prims +let (dbg_ExtractionReify : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ExtractionReify" type tydef_declaration = (FStar_Extraction_ML_Syntax.mlsymbol * FStar_Extraction_ML_Syntax.metadata * Prims.int) @@ -1181,10 +1183,7 @@ let (extract_reifiable_effect : (FStar_Extraction_ML_Syntax.MLM_Let (FStar_Extraction_ML_Syntax.NonRec, [lb])))) in let rec extract_fv tm = - (let uu___1 = - let uu___2 = FStar_Extraction_ML_UEnv.tcenv_of_uenv g in - FStar_TypeChecker_Env.debug uu___2 - (FStar_Options.Other "ExtractionReify") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_ExtractionReify in if uu___1 then let uu___2 = FStar_Syntax_Print.term_to_string tm in @@ -1218,10 +1217,7 @@ let (extract_reifiable_effect : FStar_Compiler_Util.format2 "(%s) Not an fv: %s" uu___4 uu___5 in FStar_Compiler_Effect.failwith uu___3) in let extract_action g1 a = - (let uu___1 = - let uu___2 = FStar_Extraction_ML_UEnv.tcenv_of_uenv g1 in - FStar_TypeChecker_Env.debug uu___2 - (FStar_Options.Other "ExtractionReify") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_ExtractionReify in if uu___1 then let uu___2 = @@ -1278,10 +1274,7 @@ let (extract_reifiable_effect : (match uu___4 with | (a_nm, a_lid, exp_b, g2) -> ((let uu___6 = - let uu___7 = - FStar_Extraction_ML_UEnv.tcenv_of_uenv g2 in - FStar_TypeChecker_Env.debug uu___7 - (FStar_Options.Other "ExtractionReify") in + FStar_Compiler_Effect.op_Bang dbg_ExtractionReify in if uu___6 then let uu___7 = @@ -1291,10 +1284,7 @@ let (extract_reifiable_effect : "Extracted action term: %s\n" uu___7 else ()); (let uu___7 = - let uu___8 = - FStar_Extraction_ML_UEnv.tcenv_of_uenv g2 in - FStar_TypeChecker_Env.debug uu___8 - (FStar_Options.Other "ExtractionReify") in + FStar_Compiler_Effect.op_Bang dbg_ExtractionReify in if uu___7 then ((let uu___9 = @@ -1854,7 +1844,7 @@ let (extract_iface : let uu___ = FStar_Syntax_Unionfind.with_uf_enabled (fun uu___1 -> - let uu___2 = FStar_Options.debug_any () in + let uu___2 = FStar_Compiler_Debug.any () in if uu___2 then let uu___3 = @@ -2943,10 +2933,7 @@ let (extract' : FStar_Compiler_Util.fold_map (fun g4 -> fun se -> - let uu___3 = - let uu___4 = - FStar_Ident.string_of_lid m.FStar_Syntax_Syntax.name in - FStar_Options.debug_module uu___4 in + let uu___3 = FStar_Compiler_Debug.any () in if uu___3 then let nm = diff --git a/ocaml/fstar-lib/generated/FStar_Extraction_ML_RegEmb.ml b/ocaml/fstar-lib/generated/FStar_Extraction_ML_RegEmb.ml index aac544dad71..50e4adc12cc 100644 --- a/ocaml/fstar-lib/generated/FStar_Extraction_ML_RegEmb.ml +++ b/ocaml/fstar-lib/generated/FStar_Extraction_ML_RegEmb.ml @@ -1039,15 +1039,15 @@ let (builtin_embeddings : (FStar_Ident.lident * embedding_data) Prims.list) = uu___4 :: uu___5 in uu___2 :: uu___3 in uu___ :: uu___1 +let (dbg_plugin : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Plugins" let (local_fv_embeddings : (FStar_Ident.lident * embedding_data) Prims.list FStar_Compiler_Effect.ref) = FStar_Compiler_Util.mk_ref [] let (register_embedding : FStar_Ident.lident -> embedding_data -> unit) = fun l -> fun d -> - (let uu___1 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Plugins") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_plugin in if uu___1 then let uu___2 = FStar_Ident.string_of_lid l in diff --git a/ocaml/fstar-lib/generated/FStar_Extraction_ML_Term.ml b/ocaml/fstar-lib/generated/FStar_Extraction_ML_Term.ml index 01396d86335..fc86e1b84f5 100644 --- a/ocaml/fstar-lib/generated/FStar_Extraction_ML_Term.ml +++ b/ocaml/fstar-lib/generated/FStar_Extraction_ML_Term.ml @@ -1,4 +1,8 @@ open Prims +let (dbg_Extraction : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Extraction" +let (dbg_ExtractionNorm : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ExtractionNorm" exception Un_extractable let (uu___is_Un_extractable : Prims.exn -> Prims.bool) = fun projectee -> @@ -3945,11 +3949,10 @@ and (term_as_mlexpr' : lb.FStar_Syntax_Syntax.lbdef) uu___3 "FStar.Extraction.ML.Term.normalize_lb_def" in let uu___2 = - (FStar_TypeChecker_Env.debug tcenv - (FStar_Options.Other "Extraction")) + (FStar_Compiler_Effect.op_Bang dbg_Extraction) || - (FStar_TypeChecker_Env.debug tcenv - (FStar_Options.Other "ExtractNorm")) in + (FStar_Compiler_Effect.op_Bang + dbg_ExtractionNorm) in if uu___2 then ((let uu___4 = diff --git a/ocaml/fstar-lib/generated/FStar_Extraction_ML_UEnv.ml b/ocaml/fstar-lib/generated/FStar_Extraction_ML_UEnv.ml index 050ee12368e..104e8cd1a88 100644 --- a/ocaml/fstar-lib/generated/FStar_Extraction_ML_UEnv.ml +++ b/ocaml/fstar-lib/generated/FStar_Extraction_ML_UEnv.ml @@ -251,12 +251,13 @@ let with_typars_env : currentModule = (u.currentModule) }, x) let (bindings_of_uenv : uenv -> binding Prims.list) = fun u -> u.env_bindings +let (dbg : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Extraction" let (debug : uenv -> (unit -> unit) -> unit) = fun g -> fun f -> let c = FStar_Extraction_ML_Syntax.string_of_mlpath g.currentModule in - let uu___ = - FStar_Options.debug_at_level c (FStar_Options.Other "Extraction") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg in if uu___ then f () else () let (print_mlpath_map : uenv -> Prims.string) = fun g -> diff --git a/ocaml/fstar-lib/generated/FStar_Interactive_Ide.ml b/ocaml/fstar-lib/generated/FStar_Interactive_Ide.ml index b6d7f0360c3..817b5eabee5 100644 --- a/ocaml/fstar-lib/generated/FStar_Interactive_Ide.ml +++ b/ocaml/fstar-lib/generated/FStar_Interactive_Ide.ml @@ -1,4 +1,6 @@ open Prims +let (dbg : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "IDE" let with_captured_errors' : 'uuuuu . FStar_TypeChecker_Env.env -> @@ -150,9 +152,7 @@ let (run_repl_ld_transactions : fun tasks -> fun progress_callback -> let debug verb task = - let uu___ = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "IDE") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg in if uu___ then let uu___1 = FStar_Interactive_Ide_Types.string_of_repl_task task in @@ -1836,8 +1836,7 @@ let (run_push_with_deps : = fun st -> fun query -> - (let uu___1 = - FStar_Options.debug_at_level_no_module (FStar_Options.Other "IDE") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg in if uu___1 then FStar_Compiler_Util.print_string "Reloading dependencies" else ()); @@ -2702,8 +2701,7 @@ let (maybe_cancel_queries : fun st -> fun l -> let log_cancellation l1 = - let uu___ = - FStar_Options.debug_at_level_no_module (FStar_Options.Other "IDE") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg in if uu___ then FStar_Compiler_List.iter @@ -2899,8 +2897,7 @@ and (validate_and_run_query : FStar_Compiler_Effect.op_Colon_Equals repl_current_qid (FStar_Pervasives_Native.Some (query1.FStar_Interactive_Ide_Types.qid)); - (let uu___2 = - FStar_Options.debug_at_level_no_module (FStar_Options.Other "IDE") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg in if uu___2 then let uu___3 = FStar_Interactive_Ide_Types.query_to_string query1 in diff --git a/ocaml/fstar-lib/generated/FStar_Interactive_Incremental.ml b/ocaml/fstar-lib/generated/FStar_Interactive_Incremental.ml index 6c6473678e9..05f08f5e064 100644 --- a/ocaml/fstar-lib/generated/FStar_Interactive_Incremental.ml +++ b/ocaml/fstar-lib/generated/FStar_Interactive_Incremental.ml @@ -490,7 +490,7 @@ let (run_full_buffer : FStar_Interactive_Ide_Types.Cache then log_syntax_issues err_opt else (); - (let uu___6 = FStar_Options.debug_any () in + (let uu___6 = FStar_Compiler_Debug.any () in if uu___6 then let uu___7 = diff --git a/ocaml/fstar-lib/generated/FStar_Interactive_Legacy.ml b/ocaml/fstar-lib/generated/FStar_Interactive_Legacy.ml index e0d22a8cae1..25707cc8c05 100644 --- a/ocaml/fstar-lib/generated/FStar_Interactive_Legacy.ml +++ b/ocaml/fstar-lib/generated/FStar_Interactive_Legacy.ml @@ -275,7 +275,7 @@ let rec (read_chunk : unit -> input_chunks) = fun uu___ -> let s = the_interactive_state in let log = - let uu___1 = FStar_Options.debug_any () in + let uu___1 = FStar_Compiler_Debug.any () in if uu___1 then let transcript = diff --git a/ocaml/fstar-lib/generated/FStar_Main.ml b/ocaml/fstar-lib/generated/FStar_Main.ml index 19182a15478..9cb15806899 100644 --- a/ocaml/fstar-lib/generated/FStar_Main.ml +++ b/ocaml/fstar-lib/generated/FStar_Main.ml @@ -115,7 +115,7 @@ let (load_native_tactics : unit -> unit) = let cmxs_files = FStar_Compiler_List.map cmxs_file (FStar_Compiler_List.op_At modules_to_load cmxs_to_load) in - (let uu___2 = FStar_Options.debug_any () in + (let uu___2 = FStar_Compiler_Debug.any () in if uu___2 then FStar_Compiler_Util.print1 "Will try to load cmxs files: [%s]\n" diff --git a/ocaml/fstar-lib/generated/FStar_Options.ml b/ocaml/fstar-lib/generated/FStar_Options.ml index 2b56c00ddb2..c97932df033 100644 --- a/ocaml/fstar-lib/generated/FStar_Options.ml +++ b/ocaml/fstar-lib/generated/FStar_Options.ml @@ -1,22 +1,4 @@ open Prims -type debug_level_t = - | Low - | Medium - | High - | Extreme - | Other of Prims.string -let (uu___is_Low : debug_level_t -> Prims.bool) = - fun projectee -> match projectee with | Low -> true | uu___ -> false -let (uu___is_Medium : debug_level_t -> Prims.bool) = - fun projectee -> match projectee with | Medium -> true | uu___ -> false -let (uu___is_High : debug_level_t -> Prims.bool) = - fun projectee -> match projectee with | High -> true | uu___ -> false -let (uu___is_Extreme : debug_level_t -> Prims.bool) = - fun projectee -> match projectee with | Extreme -> true | uu___ -> false -let (uu___is_Other : debug_level_t -> Prims.bool) = - fun projectee -> match projectee with | Other _0 -> true | uu___ -> false -let (__proj__Other__item___0 : debug_level_t -> Prims.string) = - fun projectee -> match projectee with | Other _0 -> _0 type split_queries_t = | No | OnFailure @@ -288,9 +270,9 @@ let (defaults : (Prims.string * option_val) Prims.list) = ("cmi", (Bool false)); ("codegen", Unset); ("codegen-lib", (List [])); - ("debug", (List [])); - ("debug_level", (List [])); ("defensive", (String "no")); + ("debug", (List [])); + ("debug_all_modules", (Bool false)); ("dep", Unset); ("detail_errors", (Bool false)); ("detail_hint_replay", (Bool false)); @@ -490,10 +472,6 @@ let (get_codegen : unit -> Prims.string FStar_Pervasives_Native.option) = fun uu___ -> lookup_opt "codegen" (as_option as_string) let (get_codegen_lib : unit -> Prims.string Prims.list) = fun uu___ -> lookup_opt "codegen-lib" (as_list as_string) -let (get_debug : unit -> Prims.string Prims.list) = - fun uu___ -> lookup_opt "debug" as_comma_string_list -let (get_debug_level : unit -> Prims.string Prims.list) = - fun uu___ -> lookup_opt "debug_level" as_comma_string_list let (get_defensive : unit -> Prims.string) = fun uu___ -> lookup_opt "defensive" as_string let (get_dep : unit -> Prims.string FStar_Pervasives_Native.option) = @@ -713,29 +691,6 @@ let (get_profile_group_by_decl : unit -> Prims.bool) = let (get_profile_component : unit -> Prims.string Prims.list FStar_Pervasives_Native.option) = fun uu___ -> lookup_opt "profile_component" (as_option (as_list as_string)) -let (dlevel : Prims.string -> debug_level_t) = - fun uu___ -> - match uu___ with - | "Low" -> Low - | "Medium" -> Medium - | "High" -> High - | "Extreme" -> Extreme - | s -> Other s -let (one_debug_level_geq : debug_level_t -> debug_level_t -> Prims.bool) = - fun l1 -> - fun l2 -> - match l1 with - | Other uu___ -> l1 = l2 - | Low -> l1 = l2 - | Medium -> (l2 = Low) || (l2 = Medium) - | High -> ((l2 = Low) || (l2 = Medium)) || (l2 = High) - | Extreme -> - (((l2 = Low) || (l2 = Medium)) || (l2 = High)) || (l2 = Extreme) -let (debug_level_geq : debug_level_t -> Prims.bool) = - fun l2 -> - let uu___ = get_debug_level () in - FStar_Compiler_Util.for_some - (fun l1 -> one_debug_level_geq (dlevel l1) l2) uu___ let (universe_include_path_base_dirs : Prims.string Prims.list) = let sub_dirs = ["legacy"; "experimental"; ".cache"] in FStar_Compiler_List.collect @@ -768,6 +723,15 @@ let (display_version : unit -> unit) = "F* %s\nplatform=%s\ncompiler=%s\ndate=%s\ncommit=%s\n" uu___2 uu___3 uu___4 uu___5 uu___6 in FStar_Compiler_Util.print_string uu___1 +let (display_debug_keys : unit -> unit) = + fun uu___ -> + let keys = FStar_Compiler_Debug.list_all_toggles () in + let uu___1 = + FStar_Compiler_List.sortWith FStar_Compiler_String.compare keys in + FStar_Compiler_List.iter + (fun s -> + let uu___2 = FStar_Compiler_String.op_Hat s "\n" in + FStar_Compiler_Util.print_string uu___2) uu___1 let display_usage_aux : 'uuuuu 'uuuuu1 . (('uuuuu * Prims.string * 'uuuuu1 FStar_Getopt.opt_variant) * @@ -1016,7 +980,7 @@ let (interp_quake_arg : Prims.string -> (Prims.int * Prims.int * Prims.bool)) let uu___ = ios f1 in let uu___1 = ios f2 in (uu___, uu___1, true) else FStar_Compiler_Effect.failwith "unexpected value for --quake" | uu___ -> FStar_Compiler_Effect.failwith "unexpected value for --quake" -let (uu___461 : (((Prims.string -> unit) -> unit) * (Prims.string -> unit))) +let (uu___443 : (((Prims.string -> unit) -> unit) * (Prims.string -> unit))) = let cb = FStar_Compiler_Util.mk_ref FStar_Pervasives_Native.None in let set1 f = @@ -1028,11 +992,11 @@ let (uu___461 : (((Prims.string -> unit) -> unit) * (Prims.string -> unit))) | FStar_Pervasives_Native.Some f -> f msg in (set1, call) let (set_option_warning_callback_aux : (Prims.string -> unit) -> unit) = - match uu___461 with + match uu___443 with | (set_option_warning_callback_aux1, option_warning_callback) -> set_option_warning_callback_aux1 let (option_warning_callback : Prims.string -> unit) = - match uu___461 with + match uu___443 with | (set_option_warning_callback_aux1, option_warning_callback1) -> option_warning_callback1 let (set_option_warning_callback : (Prims.string -> unit) -> unit) = @@ -1167,22 +1131,25 @@ let rec (specs_with_types : let uu___28 = let uu___29 = text - "Print lots of debugging information while checking module" in - (FStar_Getopt.noshort, "debug", - (Accumulated (SimpleStr "module_name")), + "Debug toggles (comma-separated list of debug keys)" in + (100, "debug", + (PostProcessed + ((fun o -> + let keys = as_comma_string_list o in + FStar_Compiler_Debug.enable_toggles + keys; + o), + (Accumulated + (SimpleStr "debug toggles")))), uu___29) in let uu___29 = let uu___30 = let uu___31 = text - "Control the verbosity of debugging info" in - (FStar_Getopt.noshort, "debug_level", - (Accumulated - (OpenEnumStr - (["Low"; - "Medium"; - "High"; - "Extreme"], "..."))), uu___31) in + "Enable to make the effect of --debug apply to every module processed by the compiler, including dependencies." in + (FStar_Getopt.noshort, + "debug_all_modules", + (Const (Bool true)), uu___31) in let uu___31 = let uu___32 = let uu___33 = @@ -3137,7 +3104,32 @@ let rec (specs_with_types : (Bool true)))), uu___253) in - [uu___252] in + let uu___253 + = + let uu___254 + = + let uu___255 + = + text + "List all debug keys and exit" in + (FStar_Getopt.noshort, + "list_debug_keys", + (WithSideEffect + ((fun + uu___256 + -> + display_debug_keys + (); + FStar_Compiler_Effect.exit + Prims.int_zero), + (Const + (Bool + true)))), + uu___255) in + [uu___254] in + uu___252 + :: + uu___253 in uu___250 :: uu___251 in @@ -3481,7 +3473,7 @@ let (settable : Prims.string -> Prims.bool) = | "compat_pre_typed_indexed_effects" -> true | "disallow_unification_guards" -> true | "debug" -> true - | "debug_level" -> true + | "debug_all_modules" -> true | "defensive" -> true | "detail_errors" -> true | "detail_hint_replay" -> true @@ -3577,7 +3569,7 @@ let (settable_specs : (fun uu___ -> match uu___ with | ((uu___1, x, uu___2), uu___3) -> settable x) all_specs -let (uu___658 : +let (uu___645 : (((unit -> FStar_Getopt.parse_cmdline_res) -> unit) * (unit -> FStar_Getopt.parse_cmdline_res))) = @@ -3594,11 +3586,11 @@ let (uu___658 : (set1, call) let (set_error_flags_callback_aux : (unit -> FStar_Getopt.parse_cmdline_res) -> unit) = - match uu___658 with + match uu___645 with | (set_error_flags_callback_aux1, set_error_flags) -> set_error_flags_callback_aux1 let (set_error_flags : unit -> FStar_Getopt.parse_cmdline_res) = - match uu___658 with + match uu___645 with | (set_error_flags_callback_aux1, set_error_flags1) -> set_error_flags1 let (set_error_flags_callback : (unit -> FStar_Getopt.parse_cmdline_res) -> unit) = @@ -3958,17 +3950,6 @@ let (codegen_libs : unit -> Prims.string Prims.list Prims.list) = fun uu___ -> let uu___1 = get_codegen_lib () in FStar_Compiler_List.map (fun x -> FStar_Compiler_Util.split x ".") uu___1 -let (debug_any : unit -> Prims.bool) = - fun uu___ -> let uu___1 = get_debug () in uu___1 <> [] -let (debug_module : Prims.string -> Prims.bool) = - fun modul -> - let uu___ = get_debug () in - FStar_Compiler_List.existsb (module_name_eq modul) uu___ -let (debug_at_level_no_module : debug_level_t -> Prims.bool) = - fun level -> debug_level_geq level -let (debug_at_level : Prims.string -> debug_level_t -> Prims.bool) = - fun modul -> - fun level -> (debug_module modul) && (debug_at_level_no_module level) let (profile_group_by_decls : unit -> Prims.bool) = fun uu___ -> get_profile_group_by_decl () let (defensive : unit -> Prims.bool) = @@ -4187,6 +4168,10 @@ let (use_nbe_for_extraction : unit -> Prims.bool) = fun uu___ -> get_use_nbe_for_extraction () let (trivial_pre_for_unannotated_effectful_fns : unit -> Prims.bool) = fun uu___ -> get_trivial_pre_for_unannotated_effectful_fns () +let (debug_keys : unit -> Prims.string Prims.list) = + fun uu___ -> lookup_opt "debug" (as_list as_string) +let (debug_all_modules : unit -> Prims.bool) = + fun uu___ -> lookup_opt "debug_all_modules" as_bool let with_saved_options : 'a . (unit -> 'a) -> 'a = fun f -> let uu___ = let uu___1 = trace_error () in Prims.op_Negation uu___1 in diff --git a/ocaml/fstar-lib/generated/FStar_Parser_Dep.ml b/ocaml/fstar-lib/generated/FStar_Parser_Dep.ml index 3d30b1fd6f3..c9bfb9368c5 100644 --- a/ocaml/fstar-lib/generated/FStar_Parser_Dep.ml +++ b/ocaml/fstar-lib/generated/FStar_Parser_Dep.ml @@ -9,6 +9,8 @@ let (uu___is_Open_namespace : open_kind -> Prims.bool) = fun projectee -> match projectee with | Open_namespace -> true | uu___ -> false type module_name = Prims.string +let (dbg : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Dep" let profile : 'uuuuu . (unit -> 'uuuuu) -> Prims.string -> 'uuuuu = fun f -> fun c -> FStar_Profiling.profile f FStar_Pervasives_Native.None c let with_file_outchannel : @@ -1124,9 +1126,7 @@ let (collect_one : if uu___ then () else - (let uu___2 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Dep") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg in if uu___2 then let uu___3 = FStar_Ident.range_of_lid module_name1 in @@ -1186,9 +1186,7 @@ let (collect_one : from_parsing_data uu___1 original_map filename in match uu___ with | (deps1, has_inline_for_extraction, mo_roots) -> - ((let uu___2 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Dep") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg in if uu___2 then let uu___3 = @@ -1884,9 +1882,7 @@ let (topological_dependences_of' : "Impossible: cycle detected after cycle detection has passed" | Black -> (all_friends, all_files) | White -> - ((let uu___2 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Dep") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg in if uu___2 then let uu___3 = @@ -1909,9 +1905,7 @@ let (topological_dependences_of' : | (all_friends1, all_files1) -> (deps_add_dep dep_graph1 filename { edges = (dep_node1.edges); color = Black }; - (let uu___6 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Dep") in + (let uu___6 = FStar_Compiler_Effect.op_Bang dbg in if uu___6 then FStar_Compiler_Util.print1 "Adding %s\n" @@ -1936,9 +1930,7 @@ let (topological_dependences_of' : let uu___ = all_friend_deps dep_graph [] ([], []) root_files in match uu___ with | (friends1, all_files_0) -> - ((let uu___2 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Dep") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg in if uu___2 then let uu___3 = @@ -1957,9 +1949,7 @@ let (topological_dependences_of' : match uu___2 with | (widened1, dep_graph1) -> let uu___3 = - (let uu___5 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Dep") in + (let uu___5 = FStar_Compiler_Effect.op_Bang dbg in if uu___5 then FStar_Compiler_Util.print_string @@ -1968,9 +1958,7 @@ let (topological_dependences_of' : all_friend_deps dep_graph1 [] ([], []) root_files in (match uu___3 with | (uu___4, all_files) -> - ((let uu___6 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Dep") in + ((let uu___6 = FStar_Compiler_Effect.op_Bang dbg in if uu___6 then FStar_Compiler_Util.print1 @@ -1987,9 +1975,7 @@ let (phase1 : fun dep_graph -> fun interfaces_needing_inlining -> fun for_extraction -> - (let uu___1 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Dep") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg in if uu___1 then FStar_Compiler_Util.print_string @@ -2226,9 +2212,7 @@ let (collect : "FStar.Parser.Dep.topological_dependences_of" in match uu___3 with | (all_files, uu___4) -> - ((let uu___6 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Dep") in + ((let uu___6 = FStar_Compiler_Effect.op_Bang dbg in if uu___6 then FStar_Compiler_Util.print1 diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index f861a5aed0b..b8744245c80 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -1,4 +1,10 @@ open Prims +let (dbg_SMTEncoding : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "SMTEncoding" +let (dbg_SMTQuery : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "SMTQuery" +let (dbg_Time : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Time" let (norm_before_encoding : FStar_SMTEncoding_Env.env_t -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term) @@ -2680,10 +2686,8 @@ let (encode_top_level_let : FStar_Syntax_Util.comp_result t_body_comp in ((let uu___12 = - FStar_TypeChecker_Env.debug - env2.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other - "SMTEncoding") in + FStar_Compiler_Effect.op_Bang + dbg_SMTEncoding in if uu___12 then let uu___13 = @@ -3030,10 +3034,8 @@ let (encode_top_level_let : (match uu___12 with | (env', e1, t_norm1) -> ((let uu___14 = - FStar_TypeChecker_Env.debug - env01.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other - "SMTEncoding") in + FStar_Compiler_Effect.op_Bang + dbg_SMTEncoding in if uu___14 then let uu___15 = @@ -3067,10 +3069,8 @@ let (encode_top_level_let : (match uu___15 with | (pre_opt, tres) -> ((let uu___17 = - FStar_TypeChecker_Env.debug - env01.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other - "SMTEncoding") in + FStar_Compiler_Effect.op_Bang + dbg_SMTEncoding in if uu___17 then let uu___18 = @@ -3780,10 +3780,7 @@ let rec (encode_sigelt : let g1 = match g with | [] -> - ((let uu___2 = - FStar_TypeChecker_Env.debug - env1.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in if uu___2 then FStar_Compiler_Util.print1 "Skipped encoding of %s\n" nm @@ -3823,9 +3820,7 @@ and (encode_sigelt' : = fun env -> fun se -> - (let uu___1 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in if uu___1 then let uu___2 = FStar_Syntax_Print.sigelt_to_string se in @@ -4278,9 +4273,7 @@ and (encode_sigelt' : | FStar_Syntax_Syntax.Discriminator uu___3 -> true | uu___3 -> false) se.FStar_Syntax_Syntax.sigquals -> - ((let uu___3 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in if uu___3 then let uu___4 = FStar_Syntax_Print.sigelt_to_string_short se in @@ -4308,9 +4301,7 @@ and (encode_sigelt' : true | uu___3 -> false) se.FStar_Syntax_Syntax.sigquals) -> - ((let uu___3 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in if uu___3 then let uu___4 = FStar_Syntax_Print.sigelt_to_string_short se in @@ -4665,9 +4656,7 @@ and (encode_sigelt' : u_formals)) in FStar_Compiler_List.forall2 tp_ok tps3 us)))) in - ((let uu___4 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in + ((let uu___4 = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in if uu___4 then let uu___5 = FStar_Ident.string_of_lid t in @@ -7049,10 +7038,7 @@ let (encode_env_bindings : | FStar_Syntax_Syntax.Binding_var x -> let t1 = norm_before_encoding env1 x.FStar_Syntax_Syntax.sort in - ((let uu___2 = - FStar_TypeChecker_Env.debug - env1.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in if uu___2 then let uu___3 = FStar_Syntax_Print.bv_to_string x in @@ -7413,7 +7399,7 @@ let (encode_sig : FStar_SMTEncoding_Term.Caption uu___2 in uu___1 :: decls else decls in - (let uu___1 = FStar_TypeChecker_Env.debug tcenv FStar_Options.Medium in + (let uu___1 = FStar_Compiler_Debug.medium () in if uu___1 then let uu___2 = FStar_Syntax_Print.sigelt_to_string se in @@ -7504,8 +7490,7 @@ let (encode_modul : (if modul.FStar_Syntax_Syntax.is_interface then "interface" else "module") uu___4 in - (let uu___5 = - FStar_TypeChecker_Env.debug tcenv1 FStar_Options.Medium in + (let uu___5 = FStar_Compiler_Debug.medium () in if uu___5 then FStar_Compiler_Util.print2 @@ -7557,9 +7542,7 @@ let (encode_modul : match uu___5 with | (decls, env1) -> (give_decls_to_z3_and_set_env env1 name decls; - (let uu___8 = - FStar_TypeChecker_Env.debug tcenv1 - FStar_Options.Medium in + (let uu___8 = FStar_Compiler_Debug.medium () in if uu___8 then FStar_Compiler_Util.print1 @@ -7592,8 +7575,7 @@ let (encode_modul_from_cache : (if tcmod.FStar_Syntax_Syntax.is_interface then "interface" else "module") uu___3 in - (let uu___4 = - FStar_TypeChecker_Env.debug tcenv1 FStar_Options.Medium in + (let uu___4 = FStar_Compiler_Debug.medium () in if uu___4 then FStar_Compiler_Util.print2 @@ -7611,8 +7593,7 @@ let (encode_modul_from_cache : FStar_SMTEncoding_Env.add_fvar_binding_to_env fvb env2) env (FStar_Compiler_List.rev fvbs) in give_decls_to_z3_and_set_env env1 name decls; - (let uu___5 = - FStar_TypeChecker_Env.debug tcenv1 FStar_Options.Medium in + (let uu___5 = FStar_Compiler_Debug.medium () in if uu___5 then FStar_Compiler_Util.print1 @@ -7694,14 +7675,9 @@ let (encode_query : (match uu___3 with | (env_decls, env1) -> ((let uu___5 = - ((FStar_TypeChecker_Env.debug tcenv - FStar_Options.Medium) - || - (FStar_TypeChecker_Env.debug tcenv - (FStar_Options.Other "SMTEncoding"))) - || - (FStar_TypeChecker_Env.debug tcenv - (FStar_Options.Other "SMTQuery")) in + ((FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang dbg_SMTEncoding)) + || (FStar_Compiler_Effect.op_Bang dbg_SMTQuery) in if uu___5 then let uu___6 = FStar_Syntax_Print.term_to_string q1 in @@ -7802,40 +7778,26 @@ let (encode_query : FStar_SMTEncoding_Term.Echo "Done!"]) in ((let uu___9 = - ((FStar_TypeChecker_Env.debug - tcenv FStar_Options.Medium) + ((FStar_Compiler_Debug.medium ()) || - (FStar_TypeChecker_Env.debug - tcenv - (FStar_Options.Other - "SMTEncoding"))) + (FStar_Compiler_Effect.op_Bang + dbg_SMTEncoding)) || - (FStar_TypeChecker_Env.debug - tcenv - (FStar_Options.Other - "SMTQuery")) in + (FStar_Compiler_Effect.op_Bang + dbg_SMTQuery) in if uu___9 then FStar_Compiler_Util.print_string "} Done encoding\n" else ()); (let uu___10 = - (((FStar_TypeChecker_Env.debug - tcenv FStar_Options.Medium) - || - (FStar_TypeChecker_Env.debug - tcenv - (FStar_Options.Other - "SMTEncoding"))) + ((FStar_Compiler_Debug.medium ()) || - (FStar_TypeChecker_Env.debug - tcenv - (FStar_Options.Other - "SMTQuery"))) + (FStar_Compiler_Effect.op_Bang + dbg_SMTEncoding)) || - (FStar_TypeChecker_Env.debug - tcenv - (FStar_Options.Other "Time")) in + (FStar_Compiler_Effect.op_Bang + dbg_Time) in if uu___10 then FStar_Compiler_Util.print1 diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml index 090e2c5224c..2d68dbf5345 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml @@ -1,4 +1,10 @@ open Prims +let (dbg_PartialApp : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "PartialApp" +let (dbg_SMTEncoding : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "SMTEncoding" +let (dbg_SMTEncodingReify : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "SMTEncodingReify" let mkForall_fuel' : 'uuuuu . Prims.string -> @@ -728,9 +734,7 @@ and (encode_binders : fun fuel_opt -> fun bs -> fun env -> - (let uu___1 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - FStar_Options.Medium in + (let uu___1 = FStar_Compiler_Debug.medium () in if uu___1 then let uu___2 = FStar_Syntax_Print.binders_to_string ", " bs in @@ -1274,9 +1278,7 @@ and (encode_term : env.FStar_SMTEncoding_Env.tcenv t; (let t1 = FStar_Syntax_Subst.compress t in let t0 = t1 in - (let uu___2 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in if uu___2 then let uu___3 = FStar_Syntax_Print.tag_of_term t1 in @@ -1306,9 +1308,7 @@ and (encode_term : FStar_Compiler_Effect.failwith uu___2 | FStar_Syntax_Syntax.Tm_lazy i -> let e = FStar_Syntax_Util.unfold_lazy i in - ((let uu___3 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in if uu___3 then let uu___4 = FStar_Syntax_Print.term_to_string t1 in @@ -1343,9 +1343,7 @@ and (encode_term : FStar_Reflection_V2_Embeddings.e_term_view uu___4 in uu___3 t1.FStar_Syntax_Syntax.pos FStar_Pervasives_Native.None FStar_Syntax_Embeddings_Base.id_norm_cb in - ((let uu___4 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in + ((let uu___4 = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in if uu___4 then let uu___5 = FStar_Syntax_Print.term_to_string t0 in @@ -2064,9 +2062,8 @@ and (encode_term : FStar_SMTEncoding_Term.hash_of_term tkey in ((let uu___9 = - FStar_TypeChecker_Env.debug - env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in + FStar_Compiler_Effect.op_Bang + dbg_SMTEncoding in if uu___9 then let uu___10 = @@ -2372,10 +2369,8 @@ and (encode_term : env.FStar_SMTEncoding_Env.tcenv [] uu___8 in ((let uu___9 = - FStar_TypeChecker_Env.debug - env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other - "SMTEncodingReify") in + FStar_Compiler_Effect.op_Bang + dbg_SMTEncodingReify in if uu___9 then let uu___10 = @@ -2584,10 +2579,8 @@ and (encode_term : (match uu___8 with | (head_type2, formals, c) -> ((let uu___10 = - FStar_TypeChecker_Env.debug - env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other - "PartialApp") in + FStar_Compiler_Effect.op_Bang + dbg_PartialApp in if uu___10 then let uu___11 = @@ -2840,10 +2833,8 @@ and (encode_term : FStar_SMTEncoding_Term.hash_of_term tkey in ((let uu___11 = - FStar_TypeChecker_Env.debug - env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other - "PartialApp") in + FStar_Compiler_Effect.op_Bang + dbg_PartialApp in if uu___11 then let uu___12 = @@ -3199,9 +3190,7 @@ and (encode_pat : = fun env -> fun pat -> - (let uu___1 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - FStar_Options.Medium in + (let uu___1 = FStar_Compiler_Debug.medium () in if uu___1 then let uu___2 = FStar_Syntax_Print.pat_to_string pat in @@ -3433,9 +3422,7 @@ and (encode_formula : fun phi -> fun env -> let debug phi1 = - let uu___ = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in if uu___ then let uu___1 = FStar_Syntax_Print.tag_of_term phi1 in diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Env.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Env.ml index 9ec8b772ce6..8be688d87b5 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Env.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Env.ml @@ -1,4 +1,6 @@ open Prims +let (dbg_PartialApp : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "PartialApp" exception Inner_let_rec of (Prims.string * FStar_Compiler_Range_Type.range) Prims.list let (uu___is_Inner_let_rec : Prims.exn -> Prims.bool) = @@ -922,9 +924,7 @@ let (try_lookup_free_var : match uu___ with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some fvb -> - ((let uu___2 = - FStar_TypeChecker_Env.debug env.tcenv - (FStar_Options.Other "PartialApp") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_PartialApp in if uu___2 then let uu___3 = FStar_Ident.string_of_lid l in diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml index 0f14fb2829c..51ea5b6039b 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml @@ -1666,7 +1666,7 @@ let (ask_solver_quake : query_settings Prims.list -> answer) = ((let uu___5 = (quaking_or_retrying && ((FStar_Options.interactive ()) || - (FStar_Options.debug_any ()))) + (FStar_Compiler_Debug.any ()))) && (n > Prims.int_zero) in if uu___5 then @@ -2233,7 +2233,7 @@ let (encode_and_ask : (let uu___7 = FStar_Options.split_queries () in uu___7 = FStar_Options.Always)) - && (FStar_Options.debug_any ()) in + && (FStar_Compiler_Debug.any ()) in if uu___6 then let n = FStar_Compiler_List.length labels in diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Z3.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Z3.ml index 0c3f9809670..95021b2ab14 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Z3.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Z3.ml @@ -145,7 +145,7 @@ let (z3_exe : unit -> Prims.string) = else (let uu___3 = inpath z3_v in if uu___3 then z3_v else FStar_Platform.exe "z3") in - (let uu___3 = FStar_Options.debug_any () in + (let uu___3 = FStar_Compiler_Debug.any () in if uu___3 then FStar_Compiler_Util.print1 "Chosen Z3 executable: %s\n" path else ()); @@ -817,7 +817,7 @@ let (doZ3Exe : res else ru) in let status = - (let uu___1 = FStar_Options.debug_any () in + (let uu___1 = FStar_Compiler_Debug.any () in if uu___1 then let uu___2 = diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Compress.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Compress.ml index d62012594e9..a27ec96e9b5 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Compress.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Compress.ml @@ -21,7 +21,7 @@ let (compress1_t : FStar_Errors.raise_err uu___ | FStar_Syntax_Syntax.Tm_name bv when Prims.op_Negation allow_names -> - ((let uu___1 = FStar_Options.debug_any () in + ((let uu___1 = FStar_Compiler_Debug.any () in if uu___1 then let uu___2 = @@ -80,7 +80,7 @@ let (compress1_u : fun u -> match u with | FStar_Syntax_Syntax.U_name bv when Prims.op_Negation allow_names -> - ((let uu___1 = FStar_Options.debug_any () in + ((let uu___1 = FStar_Compiler_Debug.any () in if uu___1 then let uu___2 = diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml index 11af4ebe0fe..3ee32e8a0ea 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml @@ -1,4 +1,8 @@ open Prims +let (dbg_Tac : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Tac" +let (dbg_SpinoffAll : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "SpinoffAll" let (run_tactic_on_typ : FStar_Compiler_Range_Type.range -> FStar_Compiler_Range_Type.range -> @@ -554,150 +558,142 @@ let (preprocess : fun goal -> FStar_Errors.with_ctx "While preprocessing VC with a tactic" (fun uu___ -> - (let uu___2 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Tac") in - FStar_Compiler_Effect.op_Colon_Equals - FStar_Tactics_Interpreter.tacdbg uu___2); - (let uu___3 = - FStar_Compiler_Effect.op_Bang FStar_Tactics_Interpreter.tacdbg in - if uu___3 + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Tac in + if uu___2 then + let uu___3 = + let uu___4 = FStar_TypeChecker_Env.all_binders env in + FStar_Syntax_Print.binders_to_string "," uu___4 in let uu___4 = - let uu___5 = FStar_TypeChecker_Env.all_binders env in - FStar_Syntax_Print.binders_to_string "," uu___5 in - let uu___5 = FStar_Class_Show.show FStar_Syntax_Print.showable_term goal in FStar_Compiler_Util.print2 "About to preprocess %s |= %s\n" - uu___4 uu___5 + uu___3 uu___4 else ()); (let initial = (Prims.int_one, []) in - let uu___3 = - let uu___4 = traverse by_tactic_interp Pos env goal in - match uu___4 with + let uu___2 = + let uu___3 = traverse by_tactic_interp Pos env goal in + match uu___3 with | Unchanged t' -> (false, (t', [])) | Simplified (t', gs) -> (true, (t', gs)) - | uu___5 -> + | uu___4 -> FStar_Compiler_Effect.failwith "preprocess: impossible, traverse returned a Dual" in - match uu___3 with + match uu___2 with | (did_anything, (t', gs)) -> - ((let uu___5 = - FStar_Compiler_Effect.op_Bang - FStar_Tactics_Interpreter.tacdbg in - if uu___5 + ((let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Tac in + if uu___4 then + let uu___5 = + let uu___6 = FStar_TypeChecker_Env.all_binders env in + FStar_Syntax_Print.binders_to_string ", " uu___6 in let uu___6 = - let uu___7 = FStar_TypeChecker_Env.all_binders env in - FStar_Syntax_Print.binders_to_string ", " uu___7 in - let uu___7 = FStar_Class_Show.show FStar_Syntax_Print.showable_term t' in FStar_Compiler_Util.print2 - "Main goal simplified to: %s |- %s\n" uu___6 uu___7 + "Main goal simplified to: %s |- %s\n" uu___5 uu___6 else ()); (let s = initial in let s1 = FStar_Compiler_List.fold_left - (fun uu___5 -> + (fun uu___4 -> fun g -> - match uu___5 with + match uu___4 with | (n, gs1) -> let phi = - let uu___6 = - let uu___7 = + let uu___5 = + let uu___6 = FStar_Tactics_Types.goal_env g in - let uu___8 = + let uu___7 = FStar_Tactics_Types.goal_type g in - getprop uu___7 uu___8 in - match uu___6 with + getprop uu___6 uu___7 in + match uu___5 with | FStar_Pervasives_Native.None -> - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = + let uu___6 = + let uu___7 = + let uu___8 = + let uu___9 = FStar_Tactics_Types.goal_type g in FStar_Class_Show.show FStar_Syntax_Print.showable_term - uu___10 in + uu___9 in FStar_Compiler_Util.format1 "Tactic returned proof-relevant goal: %s" - uu___9 in + uu___8 in (FStar_Errors_Codes.Fatal_TacticProofRelevantGoal, - uu___8) in - FStar_Errors.raise_error uu___7 + uu___7) in + FStar_Errors.raise_error uu___6 env.FStar_TypeChecker_Env.range | FStar_Pervasives_Native.Some phi1 -> phi1 in - ((let uu___7 = - FStar_Compiler_Effect.op_Bang - FStar_Tactics_Interpreter.tacdbg in - if uu___7 + ((let uu___6 = + FStar_Compiler_Effect.op_Bang dbg_Tac in + if uu___6 then - let uu___8 = + let uu___7 = FStar_Class_Show.show (FStar_Class_Show.printableshow FStar_Class_Printable.printable_int) n in - let uu___9 = - let uu___10 = + let uu___8 = + let uu___9 = FStar_Tactics_Types.goal_type g in FStar_Class_Show.show FStar_Syntax_Print.showable_term - uu___10 in + uu___9 in FStar_Compiler_Util.print2 - "Got goal #%s: %s\n" uu___8 uu___9 + "Got goal #%s: %s\n" uu___7 uu___8 else ()); (let label = - let uu___7 = - let uu___8 = + let uu___6 = + let uu___7 = FStar_Pprint.doc_of_string "Could not prove goal #" in - let uu___9 = - let uu___10 = + let uu___8 = + let uu___9 = FStar_Class_PP.pp FStar_Class_PP.pp_int n in - let uu___11 = - let uu___12 = - let uu___13 = + let uu___10 = + let uu___11 = + let uu___12 = FStar_Tactics_Types.get_label g in - uu___13 = "" in - if uu___12 + uu___12 = "" in + if uu___11 then FStar_Pprint.empty else - (let uu___14 = - let uu___15 = + (let uu___13 = + let uu___14 = FStar_Tactics_Types.get_label g in FStar_Pprint.doc_of_string - uu___15 in - FStar_Pprint.parens uu___14) in - FStar_Pprint.op_Hat_Slash_Hat uu___10 - uu___11 in - FStar_Pprint.op_Hat_Hat uu___8 uu___9 in - [uu___7] in + uu___14 in + FStar_Pprint.parens uu___13) in + FStar_Pprint.op_Hat_Slash_Hat uu___9 + uu___10 in + FStar_Pprint.op_Hat_Hat uu___7 uu___8 in + [uu___6] in let gt' = - let uu___7 = + let uu___6 = FStar_Tactics_Types.goal_range g in - FStar_TypeChecker_Util.label label uu___7 + FStar_TypeChecker_Util.label label uu___6 phi in - let uu___7 = - let uu___8 = - let uu___9 = + let uu___6 = + let uu___7 = + let uu___8 = FStar_Tactics_Types.goal_env g in - let uu___10 = + let uu___9 = FStar_Tactics_Types.goal_opts g in - (uu___9, gt', uu___10) in - uu___8 :: gs1 in - ((n + Prims.int_one), uu___7)))) s gs in - let uu___5 = s1 in - match uu___5 with - | (uu___6, gs1) -> + (uu___8, gt', uu___9) in + uu___7 :: gs1 in + ((n + Prims.int_one), uu___6)))) s gs in + let uu___4 = s1 in + match uu___4 with + | (uu___5, gs1) -> let gs2 = FStar_Compiler_List.rev gs1 in - let uu___7 = - let uu___8 = - let uu___9 = FStar_Options.peek () in - (env, t', uu___9) in - uu___8 :: gs2 in - (did_anything, uu___7))))) + let uu___6 = + let uu___7 = + let uu___8 = FStar_Options.peek () in + (env, t', uu___8) in + uu___7 :: gs2 in + (did_anything, uu___6))))) let rec (traverse_for_spinoff : pol -> (FStar_Pprint.document Prims.list * FStar_Compiler_Range_Type.range) @@ -708,9 +704,7 @@ let rec (traverse_for_spinoff : fun label_ctx -> fun e -> fun t -> - let debug_any = FStar_Options.debug_any () in - let debug = - FStar_TypeChecker_Env.debug e (FStar_Options.Other "SpinoffAll") in + let debug_any = FStar_Compiler_Debug.any () in let traverse1 pol2 e1 t1 = traverse_for_spinoff pol2 label_ctx e1 t1 in let traverse_ctx pol2 ctx e1 t1 = @@ -724,16 +718,17 @@ let rec (traverse_for_spinoff : let uu___3 = FStar_Errors_Msg.rendermsg msg in FStar_Compiler_Util.format3 "(%s,%s) : %s" uu___1 uu___2 uu___3 in - if debug - then - (let uu___1 = + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_SpinoffAll in + if uu___1 + then + let uu___2 = match label_ctx with | FStar_Pervasives_Native.None -> "None" | FStar_Pervasives_Native.Some lc -> print_lc lc in - let uu___2 = print_lc ctx in + let uu___3 = print_lc ctx in FStar_Compiler_Util.print2 - "Changing label context from %s to %s" uu___1 uu___2) - else (); + "Changing label context from %s to %s" uu___2 uu___3 + else ()); traverse_for_spinoff pol2 (FStar_Pervasives_Native.Some ctx) e1 t1 in let should_descend t1 = @@ -796,13 +791,14 @@ let rec (traverse_for_spinoff : let spinoff t2 = match pol2 with | StrictlyPositive -> - (if debug - then - (let uu___1 = + ((let uu___1 = FStar_Compiler_Effect.op_Bang dbg_SpinoffAll in + if uu___1 + then + let uu___2 = FStar_Class_Show.show FStar_Syntax_Print.showable_term t2 in - FStar_Compiler_Util.print1 "Spinning off %s\n" uu___1) - else (); + FStar_Compiler_Util.print1 "Spinning off %s\n" uu___2 + else ()); (let uu___1 = let uu___2 = let uu___3 = label_goal (e1, t2) in [uu___3] in @@ -1271,11 +1267,14 @@ let rec (traverse_for_spinoff : FStar_Syntax_Util.t_true in uu___8 = FStar_Syntax_Util.Equal) -> - (if debug - then - FStar_Compiler_Util.print_string - "Simplified squash True to True" - else (); + ((let uu___9 = + FStar_Compiler_Effect.op_Bang + dbg_SpinoffAll in + if uu___9 + then + FStar_Compiler_Util.print_string + "Simplified squash True to True" + else ()); FStar_Syntax_Util.t_true.FStar_Syntax_Syntax.n) | uu___7 -> let t' = @@ -1397,14 +1396,13 @@ let (spinoff_strictly_positive_goals : = fun env -> fun goal -> - let debug = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "SpinoffAll") in - if debug - then - (let uu___1 = + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_SpinoffAll in + if uu___1 + then + let uu___2 = FStar_Class_Show.show FStar_Syntax_Print.showable_term goal in - FStar_Compiler_Util.print1 "spinoff_all called with %s\n" uu___1) - else (); + FStar_Compiler_Util.print1 "spinoff_all called with %s\n" uu___2 + else ()); FStar_Errors.with_ctx "While spinning off all goals" (fun uu___1 -> let initial = (Prims.int_one, []) in @@ -1430,26 +1428,28 @@ let (spinoff_strictly_positive_goals : match t with | FStar_TypeChecker_Common.Trivial -> [] | FStar_TypeChecker_Common.NonTrivial t1 -> - (if debug - then - (let msg = - let uu___4 = - let uu___5 = - FStar_TypeChecker_Env.all_binders env in - FStar_Syntax_Print.binders_to_string ", " uu___5 in + ((let uu___4 = + FStar_Compiler_Effect.op_Bang dbg_SpinoffAll in + if uu___4 + then + let msg = let uu___5 = + let uu___6 = + FStar_TypeChecker_Env.all_binders env in + FStar_Syntax_Print.binders_to_string ", " uu___6 in + let uu___6 = FStar_Class_Show.show FStar_Syntax_Print.showable_term t1 in FStar_Compiler_Util.format2 - "Main goal simplified to: %s |- %s\n" uu___4 - uu___5 in - let uu___4 = FStar_TypeChecker_Env.get_range env in - let uu___5 = + "Main goal simplified to: %s |- %s\n" uu___5 + uu___6 in + let uu___5 = FStar_TypeChecker_Env.get_range env in + let uu___6 = FStar_Compiler_Util.format1 "Verification condition was to be split into several atomic sub-goals, but this query had some sub-goals that couldn't be split---the error report, if any, may be inaccurate.\n%s\n" msg in - FStar_Errors.diag uu___4 uu___5) - else (); + FStar_Errors.diag uu___5 uu___6 + else ()); [(env, t1)]) in let s = initial in let s1 = @@ -1485,15 +1485,18 @@ let (spinoff_strictly_positive_goals : | FStar_TypeChecker_Common.Trivial -> FStar_Pervasives_Native.None | FStar_TypeChecker_Common.NonTrivial t2 -> - (if debug - then - (let uu___8 = + ((let uu___8 = + FStar_Compiler_Effect.op_Bang + dbg_SpinoffAll in + if uu___8 + then + let uu___9 = FStar_Class_Show.show FStar_Syntax_Print.showable_term t2 in FStar_Compiler_Util.print1 - "Got goal: %s\n" uu___8) - else (); + "Got goal: %s\n" uu___9 + else ()); FStar_Pervasives_Native.Some (env1, t2)))) gs2 in ((let uu___6 = FStar_TypeChecker_Env.get_range env in @@ -1529,56 +1532,49 @@ let (synthesize : FStar_Syntax_Syntax.mk_Tm_app uu___1 uu___2 typ.FStar_Syntax_Syntax.pos else - ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Tac") in - FStar_Compiler_Effect.op_Colon_Equals - FStar_Tactics_Interpreter.tacdbg uu___3); - (let uu___3 = - run_tactic_on_typ tau.FStar_Syntax_Syntax.pos - typ.FStar_Syntax_Syntax.pos tau env typ in - match uu___3 with - | (gs, w) -> - (FStar_Compiler_List.iter - (fun g -> - let uu___5 = - let uu___6 = FStar_Tactics_Types.goal_env g in - let uu___7 = FStar_Tactics_Types.goal_type g in - getprop uu___6 uu___7 in - match uu___5 with - | FStar_Pervasives_Native.Some vc -> - ((let uu___7 = - FStar_Compiler_Effect.op_Bang - FStar_Tactics_Interpreter.tacdbg in - if uu___7 - then - let uu___8 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term vc in - FStar_Compiler_Util.print1 - "Synthesis left a goal: %s\n" uu___8 - else ()); - (let guard = - { - FStar_TypeChecker_Common.guard_f = - (FStar_TypeChecker_Common.NonTrivial - vc); - FStar_TypeChecker_Common.deferred_to_tac - = []; - FStar_TypeChecker_Common.deferred = []; - FStar_TypeChecker_Common.univ_ineqs = - ([], []); - FStar_TypeChecker_Common.implicits = [] - } in - let uu___7 = FStar_Tactics_Types.goal_env g in - FStar_TypeChecker_Rel.force_trivial_guard - uu___7 guard)) - | FStar_Pervasives_Native.None -> - FStar_Errors.raise_error - (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, - "synthesis left open goals") - typ.FStar_Syntax_Syntax.pos) gs; - w)))) + (let uu___2 = + run_tactic_on_typ tau.FStar_Syntax_Syntax.pos + typ.FStar_Syntax_Syntax.pos tau env typ in + match uu___2 with + | (gs, w) -> + (FStar_Compiler_List.iter + (fun g -> + let uu___4 = + let uu___5 = FStar_Tactics_Types.goal_env g in + let uu___6 = FStar_Tactics_Types.goal_type g in + getprop uu___5 uu___6 in + match uu___4 with + | FStar_Pervasives_Native.Some vc -> + ((let uu___6 = + FStar_Compiler_Effect.op_Bang dbg_Tac in + if uu___6 + then + let uu___7 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term vc in + FStar_Compiler_Util.print1 + "Synthesis left a goal: %s\n" uu___7 + else ()); + (let guard = + { + FStar_TypeChecker_Common.guard_f = + (FStar_TypeChecker_Common.NonTrivial vc); + FStar_TypeChecker_Common.deferred_to_tac + = []; + FStar_TypeChecker_Common.deferred = []; + FStar_TypeChecker_Common.univ_ineqs = + ([], []); + FStar_TypeChecker_Common.implicits = [] + } in + let uu___6 = FStar_Tactics_Types.goal_env g in + FStar_TypeChecker_Rel.force_trivial_guard + uu___6 guard)) + | FStar_Pervasives_Native.None -> + FStar_Errors.raise_error + (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, + "synthesis left open goals") + typ.FStar_Syntax_Syntax.pos) gs; + w))) let (solve_implicits : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> FStar_TypeChecker_Env.implicits -> unit) @@ -1591,87 +1587,80 @@ let (solve_implicits : if env.FStar_TypeChecker_Env.nosynth then () else - ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Tac") in - FStar_Compiler_Effect.op_Colon_Equals - FStar_Tactics_Interpreter.tacdbg uu___3); - (let gs = - let uu___3 = FStar_TypeChecker_Env.get_range env in - run_tactic_on_all_implicits tau.FStar_Syntax_Syntax.pos - uu___3 tau env imps in - (let uu___4 = - FStar_Options.profile_enabled - FStar_Pervasives_Native.None "FStar.TypeChecker" in - if uu___4 - then - let uu___5 = - FStar_Class_Show.show - (FStar_Class_Show.printableshow - FStar_Class_Printable.printable_nat) - (FStar_Compiler_List.length gs) in - FStar_Compiler_Util.print1 - "solve_implicits produced %s goals\n" uu___5 - else ()); - FStar_Options.with_saved_options - (fun uu___4 -> - let uu___5 = FStar_Options.set_options "--no_tactics" in - FStar_Compiler_List.iter - (fun g -> - (let uu___7 = FStar_Tactics_Types.goal_opts g in - FStar_Options.set uu___7); - (let uu___7 = - let uu___8 = FStar_Tactics_Types.goal_env g in - let uu___9 = FStar_Tactics_Types.goal_type g in - getprop uu___8 uu___9 in - match uu___7 with - | FStar_Pervasives_Native.Some vc -> - ((let uu___9 = - FStar_Compiler_Effect.op_Bang - FStar_Tactics_Interpreter.tacdbg in - if uu___9 - then - let uu___10 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term vc in - FStar_Compiler_Util.print1 - "Synthesis left a goal: %s\n" uu___10 - else ()); - (let uu___9 = - let uu___10 = - FStar_Options.admit_smt_queries () in - Prims.op_Negation uu___10 in - if uu___9 - then - let guard = - { - FStar_TypeChecker_Common.guard_f = - (FStar_TypeChecker_Common.NonTrivial - vc); - FStar_TypeChecker_Common.deferred_to_tac - = []; - FStar_TypeChecker_Common.deferred = - []; - FStar_TypeChecker_Common.univ_ineqs = - ([], []); - FStar_TypeChecker_Common.implicits = - [] - } in - FStar_Profiling.profile - (fun uu___10 -> - let uu___11 = - FStar_Tactics_Types.goal_env g in - FStar_TypeChecker_Rel.force_trivial_guard - uu___11 guard) - FStar_Pervasives_Native.None - "FStar.TypeChecker.Hooks.force_trivial_guard" - else ())) - | FStar_Pervasives_Native.None -> - let uu___8 = - FStar_TypeChecker_Env.get_range env in - FStar_Errors.raise_error - (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, - "synthesis left open goals") uu___8)) gs)))) + (let gs = + let uu___2 = FStar_TypeChecker_Env.get_range env in + run_tactic_on_all_implicits tau.FStar_Syntax_Syntax.pos + uu___2 tau env imps in + (let uu___3 = + FStar_Options.profile_enabled FStar_Pervasives_Native.None + "FStar.TypeChecker" in + if uu___3 + then + let uu___4 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_nat) + (FStar_Compiler_List.length gs) in + FStar_Compiler_Util.print1 + "solve_implicits produced %s goals\n" uu___4 + else ()); + FStar_Options.with_saved_options + (fun uu___3 -> + let uu___4 = FStar_Options.set_options "--no_tactics" in + FStar_Compiler_List.iter + (fun g -> + (let uu___6 = FStar_Tactics_Types.goal_opts g in + FStar_Options.set uu___6); + (let uu___6 = + let uu___7 = FStar_Tactics_Types.goal_env g in + let uu___8 = FStar_Tactics_Types.goal_type g in + getprop uu___7 uu___8 in + match uu___6 with + | FStar_Pervasives_Native.Some vc -> + ((let uu___8 = + FStar_Compiler_Effect.op_Bang dbg_Tac in + if uu___8 + then + let uu___9 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term vc in + FStar_Compiler_Util.print1 + "Synthesis left a goal: %s\n" uu___9 + else ()); + (let uu___8 = + let uu___9 = + FStar_Options.admit_smt_queries () in + Prims.op_Negation uu___9 in + if uu___8 + then + let guard = + { + FStar_TypeChecker_Common.guard_f = + (FStar_TypeChecker_Common.NonTrivial + vc); + FStar_TypeChecker_Common.deferred_to_tac + = []; + FStar_TypeChecker_Common.deferred = []; + FStar_TypeChecker_Common.univ_ineqs = + ([], []); + FStar_TypeChecker_Common.implicits = + [] + } in + FStar_Profiling.profile + (fun uu___9 -> + let uu___10 = + FStar_Tactics_Types.goal_env g in + FStar_TypeChecker_Rel.force_trivial_guard + uu___10 guard) + FStar_Pervasives_Native.None + "FStar.TypeChecker.Hooks.force_trivial_guard" + else ())) + | FStar_Pervasives_Native.None -> + let uu___7 = + FStar_TypeChecker_Env.get_range env in + FStar_Errors.raise_error + (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, + "synthesis left open goals") uu___7)) gs))) let (find_user_tac_for_attr : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> @@ -1721,55 +1710,48 @@ let (handle_smt_goal : FStar_Errors.with_ctx "While handling an SMT goal with a tactic" (fun uu___2 -> - (let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Tac") in - FStar_Compiler_Effect.op_Colon_Equals - FStar_Tactics_Interpreter.tacdbg uu___4); - (let uu___4 = - let uu___5 = FStar_TypeChecker_Env.get_range env in - let uu___6 = - FStar_Syntax_Util.mk_squash - FStar_Syntax_Syntax.U_zero goal1 in - run_tactic_on_typ tau.FStar_Syntax_Syntax.pos uu___5 - tau env uu___6 in - match uu___4 with - | (gs1, uu___5) -> - FStar_Compiler_List.map - (fun g -> - let uu___6 = - let uu___7 = FStar_Tactics_Types.goal_env g in - let uu___8 = - FStar_Tactics_Types.goal_type g in - getprop uu___7 uu___8 in - match uu___6 with - | FStar_Pervasives_Native.Some vc -> - ((let uu___8 = - FStar_Compiler_Effect.op_Bang - FStar_Tactics_Interpreter.tacdbg in - if uu___8 - then - let uu___9 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term - vc in - FStar_Compiler_Util.print1 - "handle_smt_goals left a goal: %s\n" - uu___9 - else ()); - (let uu___8 = - FStar_Tactics_Types.goal_env g in - (uu___8, vc))) - | FStar_Pervasives_Native.None -> - let uu___7 = - FStar_TypeChecker_Env.get_range env in - FStar_Errors.raise_error - (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, - "Handling an SMT goal by tactic left non-prop open goals") - uu___7) gs1)) in + let uu___3 = + let uu___4 = FStar_TypeChecker_Env.get_range env in + let uu___5 = + FStar_Syntax_Util.mk_squash + FStar_Syntax_Syntax.U_zero goal1 in + run_tactic_on_typ tau.FStar_Syntax_Syntax.pos uu___4 + tau env uu___5 in + match uu___3 with + | (gs1, uu___4) -> + FStar_Compiler_List.map + (fun g -> + let uu___5 = + let uu___6 = FStar_Tactics_Types.goal_env g in + let uu___7 = FStar_Tactics_Types.goal_type g in + getprop uu___6 uu___7 in + match uu___5 with + | FStar_Pervasives_Native.Some vc -> + ((let uu___7 = + FStar_Compiler_Effect.op_Bang dbg_Tac in + if uu___7 + then + let uu___8 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + vc in + FStar_Compiler_Util.print1 + "handle_smt_goals left a goal: %s\n" + uu___8 + else ()); + (let uu___7 = + FStar_Tactics_Types.goal_env g in + (uu___7, vc))) + | FStar_Pervasives_Native.None -> + let uu___6 = + FStar_TypeChecker_Env.get_range env in + FStar_Errors.raise_error + (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, + "Handling an SMT goal by tactic left non-prop open goals") + uu___6) gs1) in gs | FStar_Pervasives_Native.None -> [(env, goal1)]) -let (uu___844 : +let (uu___838 : FStar_Syntax_Syntax.term FStar_Syntax_Embeddings_Base.embedding) = FStar_Reflection_V2_Embeddings.e_term type blob_t = @@ -1796,534 +1778,371 @@ let (splice : if env.FStar_TypeChecker_Env.nosynth then [] else - ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Tac") in - FStar_Compiler_Effect.op_Colon_Equals - FStar_Tactics_Interpreter.tacdbg uu___3); - (let uu___3 = - if is_typed - then - FStar_TypeChecker_TcTerm.tc_check_tot_or_gtot_term - env tau FStar_Syntax_Util.t_dsl_tac_typ "" - else - FStar_TypeChecker_TcTerm.tc_tactic - FStar_Syntax_Syntax.t_unit - FStar_Syntax_Syntax.t_decls env tau in - match uu___3 with - | (tau1, uu___4, g) -> - (FStar_TypeChecker_Rel.force_trivial_guard env g; - (let ps = - FStar_Tactics_V2_Basic.proofstate_of_goals - tau1.FStar_Syntax_Syntax.pos env [] [] in - let tactic_already_typed = true in - let uu___6 = - if is_typed - then - (if - (FStar_Compiler_List.length lids) > - Prims.int_one - then + (let uu___2 = + if is_typed + then + FStar_TypeChecker_TcTerm.tc_check_tot_or_gtot_term + env tau FStar_Syntax_Util.t_dsl_tac_typ "" + else + FStar_TypeChecker_TcTerm.tc_tactic + FStar_Syntax_Syntax.t_unit + FStar_Syntax_Syntax.t_decls env tau in + match uu___2 with + | (tau1, uu___3, g) -> + (FStar_TypeChecker_Rel.force_trivial_guard env g; + (let ps = + FStar_Tactics_V2_Basic.proofstate_of_goals + tau1.FStar_Syntax_Syntax.pos env [] [] in + let tactic_already_typed = true in + let uu___5 = + if is_typed + then + (if + (FStar_Compiler_List.length lids) > + Prims.int_one + then + let uu___6 = + let uu___7 = + let uu___8 = + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Ident.showable_lident) lids in + FStar_Compiler_Util.format1 + "Typed splice: unexpected lids length (> 1) (%s)" + uu___8 in + (FStar_Errors_Codes.Error_BadSplice, + uu___7) in + FStar_Errors.raise_error uu___6 rng + else + (let val_t = + if + (FStar_Compiler_List.length lids) = + Prims.int_zero + then FStar_Pervasives_Native.None + else + (let uu___8 = + let uu___9 = + FStar_Compiler_List.hd lids in + FStar_TypeChecker_Env.try_lookup_val_decl + env uu___9 in + match uu___8 with + | FStar_Pervasives_Native.None -> + FStar_Pervasives_Native.None + | FStar_Pervasives_Native.Some + ((uvs, tval), uu___9) -> + if + (FStar_Compiler_List.length uvs) + <> Prims.int_zero + then + let uu___10 = + let uu___11 = + let uu___12 = + FStar_Compiler_Util.string_of_int + (FStar_Compiler_List.length + uvs) in + FStar_Compiler_Util.format1 + "Typed splice: val declaration for %s is universe polymorphic in %s universes, expected 0" + uu___12 in + (FStar_Errors_Codes.Error_BadSplice, + uu___11) in + FStar_Errors.raise_error uu___10 + rng + else + FStar_Pervasives_Native.Some + tval) in let uu___7 = - let uu___8 = - let uu___9 = - FStar_Class_Show.show - (FStar_Class_Show.show_list - FStar_Ident.showable_lident) - lids in - FStar_Compiler_Util.format1 - "Typed splice: unexpected lids length (> 1) (%s)" - uu___9 in - (FStar_Errors_Codes.Error_BadSplice, - uu___8) in - FStar_Errors.raise_error uu___7 rng - else - (let val_t = - if - (FStar_Compiler_List.length lids) = - Prims.int_zero - then FStar_Pervasives_Native.None - else - (let uu___9 = - let uu___10 = - FStar_Compiler_List.hd lids in - FStar_TypeChecker_Env.try_lookup_val_decl - env uu___10 in - match uu___9 with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some - ((uvs, tval), uu___10) -> - if - (FStar_Compiler_List.length uvs) - <> Prims.int_zero - then - let uu___11 = - let uu___12 = - let uu___13 = - FStar_Compiler_Util.string_of_int - (FStar_Compiler_List.length - uvs) in - FStar_Compiler_Util.format1 - "Typed splice: val declaration for %s is universe polymorphic in %s universes, expected 0" - uu___13 in - (FStar_Errors_Codes.Error_BadSplice, - uu___12) in - FStar_Errors.raise_error - uu___11 rng - else - FStar_Pervasives_Native.Some - tval) in - let uu___8 = - FStar_Tactics_Interpreter.run_tactic_on_ps - tau1.FStar_Syntax_Syntax.pos - tau1.FStar_Syntax_Syntax.pos false - (FStar_Syntax_Embeddings.e_tuple2 - FStar_Reflection_V2_Embeddings.e_env - (FStar_Syntax_Embeddings.e_option - uu___844)) - ({ - FStar_TypeChecker_Env.solver = - (env.FStar_TypeChecker_Env.solver); - FStar_TypeChecker_Env.range = - (env.FStar_TypeChecker_Env.range); - FStar_TypeChecker_Env.curmodule = - (env.FStar_TypeChecker_Env.curmodule); - FStar_TypeChecker_Env.gamma = []; - FStar_TypeChecker_Env.gamma_sig = - (env.FStar_TypeChecker_Env.gamma_sig); - FStar_TypeChecker_Env.gamma_cache = - (env.FStar_TypeChecker_Env.gamma_cache); - FStar_TypeChecker_Env.modules = - (env.FStar_TypeChecker_Env.modules); - FStar_TypeChecker_Env.expected_typ - = - (env.FStar_TypeChecker_Env.expected_typ); - FStar_TypeChecker_Env.sigtab = - (env.FStar_TypeChecker_Env.sigtab); - FStar_TypeChecker_Env.attrtab = - (env.FStar_TypeChecker_Env.attrtab); - FStar_TypeChecker_Env.instantiate_imp - = - (env.FStar_TypeChecker_Env.instantiate_imp); - FStar_TypeChecker_Env.effects = - (env.FStar_TypeChecker_Env.effects); - FStar_TypeChecker_Env.generalize = - (env.FStar_TypeChecker_Env.generalize); - FStar_TypeChecker_Env.letrecs = - (env.FStar_TypeChecker_Env.letrecs); - FStar_TypeChecker_Env.top_level = - (env.FStar_TypeChecker_Env.top_level); - FStar_TypeChecker_Env.check_uvars = - (env.FStar_TypeChecker_Env.check_uvars); - FStar_TypeChecker_Env.use_eq_strict - = - (env.FStar_TypeChecker_Env.use_eq_strict); - FStar_TypeChecker_Env.is_iface = - (env.FStar_TypeChecker_Env.is_iface); - FStar_TypeChecker_Env.admit = - (env.FStar_TypeChecker_Env.admit); - FStar_TypeChecker_Env.lax = - (env.FStar_TypeChecker_Env.lax); - FStar_TypeChecker_Env.lax_universes - = - (env.FStar_TypeChecker_Env.lax_universes); - FStar_TypeChecker_Env.phase1 = - (env.FStar_TypeChecker_Env.phase1); - FStar_TypeChecker_Env.failhard = - (env.FStar_TypeChecker_Env.failhard); - FStar_TypeChecker_Env.nosynth = - (env.FStar_TypeChecker_Env.nosynth); - FStar_TypeChecker_Env.uvar_subtyping - = - (env.FStar_TypeChecker_Env.uvar_subtyping); - FStar_TypeChecker_Env.intactics = - (env.FStar_TypeChecker_Env.intactics); - FStar_TypeChecker_Env.nocoerce = - (env.FStar_TypeChecker_Env.nocoerce); - FStar_TypeChecker_Env.tc_term = - (env.FStar_TypeChecker_Env.tc_term); - FStar_TypeChecker_Env.typeof_tot_or_gtot_term - = - (env.FStar_TypeChecker_Env.typeof_tot_or_gtot_term); - FStar_TypeChecker_Env.universe_of = - (env.FStar_TypeChecker_Env.universe_of); - FStar_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term - = - (env.FStar_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term); - FStar_TypeChecker_Env.teq_nosmt_force - = - (env.FStar_TypeChecker_Env.teq_nosmt_force); - FStar_TypeChecker_Env.subtype_nosmt_force - = - (env.FStar_TypeChecker_Env.subtype_nosmt_force); - FStar_TypeChecker_Env.qtbl_name_and_index - = - (env.FStar_TypeChecker_Env.qtbl_name_and_index); - FStar_TypeChecker_Env.normalized_eff_names - = - (env.FStar_TypeChecker_Env.normalized_eff_names); - FStar_TypeChecker_Env.fv_delta_depths - = - (env.FStar_TypeChecker_Env.fv_delta_depths); - FStar_TypeChecker_Env.proof_ns = - (env.FStar_TypeChecker_Env.proof_ns); - FStar_TypeChecker_Env.synth_hook = - (env.FStar_TypeChecker_Env.synth_hook); - FStar_TypeChecker_Env.try_solve_implicits_hook - = - (env.FStar_TypeChecker_Env.try_solve_implicits_hook); - FStar_TypeChecker_Env.splice = - (env.FStar_TypeChecker_Env.splice); - FStar_TypeChecker_Env.mpreprocess = - (env.FStar_TypeChecker_Env.mpreprocess); - FStar_TypeChecker_Env.postprocess = - (env.FStar_TypeChecker_Env.postprocess); - FStar_TypeChecker_Env.identifier_info - = - (env.FStar_TypeChecker_Env.identifier_info); - FStar_TypeChecker_Env.tc_hooks = - (env.FStar_TypeChecker_Env.tc_hooks); - FStar_TypeChecker_Env.dsenv = - (env.FStar_TypeChecker_Env.dsenv); - FStar_TypeChecker_Env.nbe = - (env.FStar_TypeChecker_Env.nbe); - FStar_TypeChecker_Env.strict_args_tab - = - (env.FStar_TypeChecker_Env.strict_args_tab); - FStar_TypeChecker_Env.erasable_types_tab - = - (env.FStar_TypeChecker_Env.erasable_types_tab); - FStar_TypeChecker_Env.enable_defer_to_tac - = - (env.FStar_TypeChecker_Env.enable_defer_to_tac); - FStar_TypeChecker_Env.unif_allow_ref_guards - = - (env.FStar_TypeChecker_Env.unif_allow_ref_guards); - FStar_TypeChecker_Env.erase_erasable_args - = - (env.FStar_TypeChecker_Env.erase_erasable_args); - FStar_TypeChecker_Env.core_check = - (env.FStar_TypeChecker_Env.core_check) - }, val_t) - (FStar_Syntax_Embeddings.e_tuple3 - (FStar_Syntax_Embeddings.e_list - (FStar_Syntax_Embeddings.e_tuple3 - FStar_Syntax_Embeddings.e_bool - FStar_Reflection_V2_Embeddings.e_sigelt - (FStar_Syntax_Embeddings.e_option - (FStar_Syntax_Embeddings.e_tuple2 - FStar_Syntax_Embeddings.e_string - uu___844)))) - (FStar_Syntax_Embeddings.e_tuple3 - FStar_Syntax_Embeddings.e_bool - FStar_Reflection_V2_Embeddings.e_sigelt - (FStar_Syntax_Embeddings.e_option - (FStar_Syntax_Embeddings.e_tuple2 - FStar_Syntax_Embeddings.e_string - uu___844))) - (FStar_Syntax_Embeddings.e_list - (FStar_Syntax_Embeddings.e_tuple3 - FStar_Syntax_Embeddings.e_bool - FStar_Reflection_V2_Embeddings.e_sigelt - (FStar_Syntax_Embeddings.e_option - (FStar_Syntax_Embeddings.e_tuple2 - FStar_Syntax_Embeddings.e_string - uu___844))))) tau1 - tactic_already_typed ps in - match uu___8 with - | (gs, - (sig_blobs_before, sig_blob, - sig_blobs_after)) -> - let uu___9 = uu___8 in - let sig_blobs = - FStar_Compiler_List.op_At - sig_blobs_before (sig_blob :: - sig_blobs_after) in - let sigelts = - FStar_Compiler_List.map - (fun uu___10 -> - match uu___10 with - | (checked, se, blob_opt) -> - let uu___11 = - let uu___12 = - se.FStar_Syntax_Syntax.sigmeta in - let uu___13 = - match blob_opt with - | FStar_Pervasives_Native.Some - (s, blob) -> - let uu___14 = - let uu___15 = - FStar_Compiler_Dyn.mkdyn - blob in - (s, uu___15) in - [uu___14] - | FStar_Pervasives_Native.None - -> [] in - { - FStar_Syntax_Syntax.sigmeta_active - = - (uu___12.FStar_Syntax_Syntax.sigmeta_active); - FStar_Syntax_Syntax.sigmeta_fact_db_ids - = - (uu___12.FStar_Syntax_Syntax.sigmeta_fact_db_ids); - FStar_Syntax_Syntax.sigmeta_admit - = - (uu___12.FStar_Syntax_Syntax.sigmeta_admit); - FStar_Syntax_Syntax.sigmeta_spliced - = - (uu___12.FStar_Syntax_Syntax.sigmeta_spliced); - FStar_Syntax_Syntax.sigmeta_already_checked - = checked; - FStar_Syntax_Syntax.sigmeta_extension_data - = uu___13 - } in - { - FStar_Syntax_Syntax.sigel - = - (se.FStar_Syntax_Syntax.sigel); - FStar_Syntax_Syntax.sigrng - = - (se.FStar_Syntax_Syntax.sigrng); - FStar_Syntax_Syntax.sigquals - = - (se.FStar_Syntax_Syntax.sigquals); - FStar_Syntax_Syntax.sigmeta - = uu___11; - FStar_Syntax_Syntax.sigattrs - = - (se.FStar_Syntax_Syntax.sigattrs); - FStar_Syntax_Syntax.sigopens_and_abbrevs - = - (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); - FStar_Syntax_Syntax.sigopts - = - (se.FStar_Syntax_Syntax.sigopts) - }) sig_blobs in - (gs, sigelts))) - else - FStar_Tactics_Interpreter.run_tactic_on_ps - tau1.FStar_Syntax_Syntax.pos - tau1.FStar_Syntax_Syntax.pos false - FStar_Syntax_Embeddings.e_unit () - (FStar_Syntax_Embeddings.e_list - FStar_Reflection_V2_Embeddings.e_sigelt) - tau1 tactic_already_typed ps in - match uu___6 with - | (gs, sigelts) -> - let sigelts1 = - let set_lb_dd lb = - let uu___7 = lb in - match uu___7 with - | { - FStar_Syntax_Syntax.lbname = - FStar_Pervasives.Inr fv; - FStar_Syntax_Syntax.lbunivs = uu___8; - FStar_Syntax_Syntax.lbtyp = uu___9; - FStar_Syntax_Syntax.lbeff = uu___10; - FStar_Syntax_Syntax.lbdef = lbdef; - FStar_Syntax_Syntax.lbattrs = uu___11; - FStar_Syntax_Syntax.lbpos = uu___12;_} - -> - { - FStar_Syntax_Syntax.lbname = - (FStar_Pervasives.Inr fv); - FStar_Syntax_Syntax.lbunivs = - (lb.FStar_Syntax_Syntax.lbunivs); - FStar_Syntax_Syntax.lbtyp = - (lb.FStar_Syntax_Syntax.lbtyp); - FStar_Syntax_Syntax.lbeff = - (lb.FStar_Syntax_Syntax.lbeff); - FStar_Syntax_Syntax.lbdef = - (lb.FStar_Syntax_Syntax.lbdef); - FStar_Syntax_Syntax.lbattrs = - (lb.FStar_Syntax_Syntax.lbattrs); - FStar_Syntax_Syntax.lbpos = - (lb.FStar_Syntax_Syntax.lbpos) - } in - FStar_Compiler_List.map - (fun se -> - match se.FStar_Syntax_Syntax.sigel with - | FStar_Syntax_Syntax.Sig_let - { - FStar_Syntax_Syntax.lbs1 = - (is_rec, lbs); - FStar_Syntax_Syntax.lids1 = lids1;_} - -> - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = - FStar_Compiler_List.map - set_lb_dd lbs in - (is_rec, uu___10) in - { - FStar_Syntax_Syntax.lbs1 = - uu___9; - FStar_Syntax_Syntax.lids1 = - lids1 - } in - FStar_Syntax_Syntax.Sig_let - uu___8 in - { - FStar_Syntax_Syntax.sigel = - uu___7; - FStar_Syntax_Syntax.sigrng = - (se.FStar_Syntax_Syntax.sigrng); - FStar_Syntax_Syntax.sigquals = - (se.FStar_Syntax_Syntax.sigquals); - FStar_Syntax_Syntax.sigmeta = - (se.FStar_Syntax_Syntax.sigmeta); - FStar_Syntax_Syntax.sigattrs = - (se.FStar_Syntax_Syntax.sigattrs); - FStar_Syntax_Syntax.sigopens_and_abbrevs - = - (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); - FStar_Syntax_Syntax.sigopts = - (se.FStar_Syntax_Syntax.sigopts) - } - | uu___7 -> se) sigelts in - (FStar_Options.with_saved_options - (fun uu___8 -> - FStar_Compiler_List.iter - (fun g1 -> - (let uu___10 = - FStar_Tactics_Types.goal_opts g1 in - FStar_Options.set uu___10); - (let uu___10 = - let uu___11 = - FStar_Tactics_Types.goal_env - g1 in - let uu___12 = - FStar_Tactics_Types.goal_type - g1 in - getprop uu___11 uu___12 in - match uu___10 with - | FStar_Pervasives_Native.Some vc - -> - ((let uu___12 = - FStar_Compiler_Effect.op_Bang - FStar_Tactics_Interpreter.tacdbg in - if uu___12 - then - let uu___13 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term - vc in - FStar_Compiler_Util.print1 - "Splice left a goal: %s\n" - uu___13 - else ()); - (let guard = + FStar_Tactics_Interpreter.run_tactic_on_ps + tau1.FStar_Syntax_Syntax.pos + tau1.FStar_Syntax_Syntax.pos false + (FStar_Syntax_Embeddings.e_tuple2 + FStar_Reflection_V2_Embeddings.e_env + (FStar_Syntax_Embeddings.e_option + uu___838)) + ({ + FStar_TypeChecker_Env.solver = + (env.FStar_TypeChecker_Env.solver); + FStar_TypeChecker_Env.range = + (env.FStar_TypeChecker_Env.range); + FStar_TypeChecker_Env.curmodule = + (env.FStar_TypeChecker_Env.curmodule); + FStar_TypeChecker_Env.gamma = []; + FStar_TypeChecker_Env.gamma_sig = + (env.FStar_TypeChecker_Env.gamma_sig); + FStar_TypeChecker_Env.gamma_cache = + (env.FStar_TypeChecker_Env.gamma_cache); + FStar_TypeChecker_Env.modules = + (env.FStar_TypeChecker_Env.modules); + FStar_TypeChecker_Env.expected_typ = + (env.FStar_TypeChecker_Env.expected_typ); + FStar_TypeChecker_Env.sigtab = + (env.FStar_TypeChecker_Env.sigtab); + FStar_TypeChecker_Env.attrtab = + (env.FStar_TypeChecker_Env.attrtab); + FStar_TypeChecker_Env.instantiate_imp + = + (env.FStar_TypeChecker_Env.instantiate_imp); + FStar_TypeChecker_Env.effects = + (env.FStar_TypeChecker_Env.effects); + FStar_TypeChecker_Env.generalize = + (env.FStar_TypeChecker_Env.generalize); + FStar_TypeChecker_Env.letrecs = + (env.FStar_TypeChecker_Env.letrecs); + FStar_TypeChecker_Env.top_level = + (env.FStar_TypeChecker_Env.top_level); + FStar_TypeChecker_Env.check_uvars = + (env.FStar_TypeChecker_Env.check_uvars); + FStar_TypeChecker_Env.use_eq_strict + = + (env.FStar_TypeChecker_Env.use_eq_strict); + FStar_TypeChecker_Env.is_iface = + (env.FStar_TypeChecker_Env.is_iface); + FStar_TypeChecker_Env.admit = + (env.FStar_TypeChecker_Env.admit); + FStar_TypeChecker_Env.lax = + (env.FStar_TypeChecker_Env.lax); + FStar_TypeChecker_Env.lax_universes + = + (env.FStar_TypeChecker_Env.lax_universes); + FStar_TypeChecker_Env.phase1 = + (env.FStar_TypeChecker_Env.phase1); + FStar_TypeChecker_Env.failhard = + (env.FStar_TypeChecker_Env.failhard); + FStar_TypeChecker_Env.nosynth = + (env.FStar_TypeChecker_Env.nosynth); + FStar_TypeChecker_Env.uvar_subtyping + = + (env.FStar_TypeChecker_Env.uvar_subtyping); + FStar_TypeChecker_Env.intactics = + (env.FStar_TypeChecker_Env.intactics); + FStar_TypeChecker_Env.nocoerce = + (env.FStar_TypeChecker_Env.nocoerce); + FStar_TypeChecker_Env.tc_term = + (env.FStar_TypeChecker_Env.tc_term); + FStar_TypeChecker_Env.typeof_tot_or_gtot_term + = + (env.FStar_TypeChecker_Env.typeof_tot_or_gtot_term); + FStar_TypeChecker_Env.universe_of = + (env.FStar_TypeChecker_Env.universe_of); + FStar_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term + = + (env.FStar_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term); + FStar_TypeChecker_Env.teq_nosmt_force + = + (env.FStar_TypeChecker_Env.teq_nosmt_force); + FStar_TypeChecker_Env.subtype_nosmt_force + = + (env.FStar_TypeChecker_Env.subtype_nosmt_force); + FStar_TypeChecker_Env.qtbl_name_and_index + = + (env.FStar_TypeChecker_Env.qtbl_name_and_index); + FStar_TypeChecker_Env.normalized_eff_names + = + (env.FStar_TypeChecker_Env.normalized_eff_names); + FStar_TypeChecker_Env.fv_delta_depths + = + (env.FStar_TypeChecker_Env.fv_delta_depths); + FStar_TypeChecker_Env.proof_ns = + (env.FStar_TypeChecker_Env.proof_ns); + FStar_TypeChecker_Env.synth_hook = + (env.FStar_TypeChecker_Env.synth_hook); + FStar_TypeChecker_Env.try_solve_implicits_hook + = + (env.FStar_TypeChecker_Env.try_solve_implicits_hook); + FStar_TypeChecker_Env.splice = + (env.FStar_TypeChecker_Env.splice); + FStar_TypeChecker_Env.mpreprocess = + (env.FStar_TypeChecker_Env.mpreprocess); + FStar_TypeChecker_Env.postprocess = + (env.FStar_TypeChecker_Env.postprocess); + FStar_TypeChecker_Env.identifier_info + = + (env.FStar_TypeChecker_Env.identifier_info); + FStar_TypeChecker_Env.tc_hooks = + (env.FStar_TypeChecker_Env.tc_hooks); + FStar_TypeChecker_Env.dsenv = + (env.FStar_TypeChecker_Env.dsenv); + FStar_TypeChecker_Env.nbe = + (env.FStar_TypeChecker_Env.nbe); + FStar_TypeChecker_Env.strict_args_tab + = + (env.FStar_TypeChecker_Env.strict_args_tab); + FStar_TypeChecker_Env.erasable_types_tab + = + (env.FStar_TypeChecker_Env.erasable_types_tab); + FStar_TypeChecker_Env.enable_defer_to_tac + = + (env.FStar_TypeChecker_Env.enable_defer_to_tac); + FStar_TypeChecker_Env.unif_allow_ref_guards + = + (env.FStar_TypeChecker_Env.unif_allow_ref_guards); + FStar_TypeChecker_Env.erase_erasable_args + = + (env.FStar_TypeChecker_Env.erase_erasable_args); + FStar_TypeChecker_Env.core_check = + (env.FStar_TypeChecker_Env.core_check) + }, val_t) + (FStar_Syntax_Embeddings.e_tuple3 + (FStar_Syntax_Embeddings.e_list + (FStar_Syntax_Embeddings.e_tuple3 + FStar_Syntax_Embeddings.e_bool + FStar_Reflection_V2_Embeddings.e_sigelt + (FStar_Syntax_Embeddings.e_option + (FStar_Syntax_Embeddings.e_tuple2 + FStar_Syntax_Embeddings.e_string + uu___838)))) + (FStar_Syntax_Embeddings.e_tuple3 + FStar_Syntax_Embeddings.e_bool + FStar_Reflection_V2_Embeddings.e_sigelt + (FStar_Syntax_Embeddings.e_option + (FStar_Syntax_Embeddings.e_tuple2 + FStar_Syntax_Embeddings.e_string + uu___838))) + (FStar_Syntax_Embeddings.e_list + (FStar_Syntax_Embeddings.e_tuple3 + FStar_Syntax_Embeddings.e_bool + FStar_Reflection_V2_Embeddings.e_sigelt + (FStar_Syntax_Embeddings.e_option + (FStar_Syntax_Embeddings.e_tuple2 + FStar_Syntax_Embeddings.e_string + uu___838))))) tau1 + tactic_already_typed ps in + match uu___7 with + | (gs, + (sig_blobs_before, sig_blob, + sig_blobs_after)) -> + let uu___8 = uu___7 in + let sig_blobs = + FStar_Compiler_List.op_At + sig_blobs_before (sig_blob :: + sig_blobs_after) in + let sigelts = + FStar_Compiler_List.map + (fun uu___9 -> + match uu___9 with + | (checked, se, blob_opt) -> + let uu___10 = + let uu___11 = + se.FStar_Syntax_Syntax.sigmeta in + let uu___12 = + match blob_opt with + | FStar_Pervasives_Native.Some + (s, blob) -> + let uu___13 = + let uu___14 = + FStar_Compiler_Dyn.mkdyn + blob in + (s, uu___14) in + [uu___13] + | FStar_Pervasives_Native.None + -> [] in { - FStar_TypeChecker_Common.guard_f + FStar_Syntax_Syntax.sigmeta_active + = + (uu___11.FStar_Syntax_Syntax.sigmeta_active); + FStar_Syntax_Syntax.sigmeta_fact_db_ids + = + (uu___11.FStar_Syntax_Syntax.sigmeta_fact_db_ids); + FStar_Syntax_Syntax.sigmeta_admit = - (FStar_TypeChecker_Common.NonTrivial - vc); - FStar_TypeChecker_Common.deferred_to_tac - = []; - FStar_TypeChecker_Common.deferred - = []; - FStar_TypeChecker_Common.univ_ineqs - = ([], []); - FStar_TypeChecker_Common.implicits - = [] + (uu___11.FStar_Syntax_Syntax.sigmeta_admit); + FStar_Syntax_Syntax.sigmeta_spliced + = + (uu___11.FStar_Syntax_Syntax.sigmeta_spliced); + FStar_Syntax_Syntax.sigmeta_already_checked + = checked; + FStar_Syntax_Syntax.sigmeta_extension_data + = uu___12 } in - let uu___12 = - FStar_Tactics_Types.goal_env - g1 in - FStar_TypeChecker_Rel.force_trivial_guard - uu___12 guard)) - | FStar_Pervasives_Native.None -> - FStar_Errors.raise_error - (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, - "splice left open goals") - rng)) gs); - (let lids' = - FStar_Compiler_List.collect - FStar_Syntax_Util.lids_of_sigelt - sigelts1 in - FStar_Compiler_List.iter - (fun lid -> - let uu___9 = - FStar_Compiler_List.tryFind - (FStar_Ident.lid_equals lid) lids' in - match uu___9 with - | FStar_Pervasives_Native.None when - Prims.op_Negation - env.FStar_TypeChecker_Env.nosynth - -> - let uu___10 = - let uu___11 = - let uu___12 = - FStar_Class_Show.show - FStar_Ident.showable_lident - lid in - let uu___13 = - FStar_Class_Show.show - (FStar_Class_Show.show_list - FStar_Ident.showable_lident) - lids' in - FStar_Compiler_Util.format2 - "Splice declared the name %s but it was not defined.\nThose defined were: %s" - uu___12 uu___13 in - (FStar_Errors_Codes.Fatal_SplicedUndef, - uu___11) in - FStar_Errors.raise_error uu___10 - rng - | uu___10 -> ()) lids; - (let uu___10 = - FStar_Compiler_Effect.op_Bang - FStar_Tactics_Interpreter.tacdbg in - if uu___10 - then - let uu___11 = - FStar_Class_Show.show - (FStar_Class_Show.show_list - FStar_Syntax_Print.showable_sigelt) - sigelts1 in - FStar_Compiler_Util.print1 - "splice: got decls = {\n\n%s\n\n}\n" - uu___11 - else ()); - (let sigelts2 = - FStar_Compiler_List.map - (fun se -> - (match se.FStar_Syntax_Syntax.sigel - with - | FStar_Syntax_Syntax.Sig_datacon - uu___11 -> - let uu___12 = - let uu___13 = - let uu___14 = - FStar_Syntax_Print.sigelt_to_string_short - se in - FStar_Compiler_Util.format1 - "Tactic returned bad sigelt: %s\nIf you wanted to splice an inductive type, call `pack` providing a `Sg_Inductive` to get a proper sigelt." - uu___14 in - (FStar_Errors_Codes.Error_BadSplice, - uu___13) in - FStar_Errors.raise_error - uu___12 rng - | FStar_Syntax_Syntax.Sig_inductive_typ - uu___11 -> - let uu___12 = - let uu___13 = - let uu___14 = - FStar_Syntax_Print.sigelt_to_string_short - se in - FStar_Compiler_Util.format1 - "Tactic returned bad sigelt: %s\nIf you wanted to splice an inductive type, call `pack` providing a `Sg_Inductive` to get a proper sigelt." - uu___14 in - (FStar_Errors_Codes.Error_BadSplice, - uu___13) in - FStar_Errors.raise_error - uu___12 rng - | uu___11 -> ()); + { + FStar_Syntax_Syntax.sigel + = + (se.FStar_Syntax_Syntax.sigel); + FStar_Syntax_Syntax.sigrng + = + (se.FStar_Syntax_Syntax.sigrng); + FStar_Syntax_Syntax.sigquals + = + (se.FStar_Syntax_Syntax.sigquals); + FStar_Syntax_Syntax.sigmeta + = uu___10; + FStar_Syntax_Syntax.sigattrs + = + (se.FStar_Syntax_Syntax.sigattrs); + FStar_Syntax_Syntax.sigopens_and_abbrevs + = + (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); + FStar_Syntax_Syntax.sigopts + = + (se.FStar_Syntax_Syntax.sigopts) + }) sig_blobs in + (gs, sigelts))) + else + FStar_Tactics_Interpreter.run_tactic_on_ps + tau1.FStar_Syntax_Syntax.pos + tau1.FStar_Syntax_Syntax.pos false + FStar_Syntax_Embeddings.e_unit () + (FStar_Syntax_Embeddings.e_list + FStar_Reflection_V2_Embeddings.e_sigelt) + tau1 tactic_already_typed ps in + match uu___5 with + | (gs, sigelts) -> + let sigelts1 = + let set_lb_dd lb = + let uu___6 = lb in + match uu___6 with + | { + FStar_Syntax_Syntax.lbname = + FStar_Pervasives.Inr fv; + FStar_Syntax_Syntax.lbunivs = uu___7; + FStar_Syntax_Syntax.lbtyp = uu___8; + FStar_Syntax_Syntax.lbeff = uu___9; + FStar_Syntax_Syntax.lbdef = lbdef; + FStar_Syntax_Syntax.lbattrs = uu___10; + FStar_Syntax_Syntax.lbpos = uu___11;_} + -> + { + FStar_Syntax_Syntax.lbname = + (FStar_Pervasives.Inr fv); + FStar_Syntax_Syntax.lbunivs = + (lb.FStar_Syntax_Syntax.lbunivs); + FStar_Syntax_Syntax.lbtyp = + (lb.FStar_Syntax_Syntax.lbtyp); + FStar_Syntax_Syntax.lbeff = + (lb.FStar_Syntax_Syntax.lbeff); + FStar_Syntax_Syntax.lbdef = + (lb.FStar_Syntax_Syntax.lbdef); + FStar_Syntax_Syntax.lbattrs = + (lb.FStar_Syntax_Syntax.lbattrs); + FStar_Syntax_Syntax.lbpos = + (lb.FStar_Syntax_Syntax.lbpos) + } in + FStar_Compiler_List.map + (fun se -> + match se.FStar_Syntax_Syntax.sigel with + | FStar_Syntax_Syntax.Sig_let + { + FStar_Syntax_Syntax.lbs1 = + (is_rec, lbs); + FStar_Syntax_Syntax.lids1 = lids1;_} + -> + let uu___6 = + let uu___7 = + let uu___8 = + let uu___9 = + FStar_Compiler_List.map + set_lb_dd lbs in + (is_rec, uu___9) in + { + FStar_Syntax_Syntax.lbs1 = + uu___8; + FStar_Syntax_Syntax.lids1 = + lids1 + } in + FStar_Syntax_Syntax.Sig_let uu___7 in { - FStar_Syntax_Syntax.sigel = - (se.FStar_Syntax_Syntax.sigel); - FStar_Syntax_Syntax.sigrng = rng; + FStar_Syntax_Syntax.sigel = uu___6; + FStar_Syntax_Syntax.sigrng = + (se.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = (se.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta = @@ -2335,38 +2154,188 @@ let (splice : (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); FStar_Syntax_Syntax.sigopts = (se.FStar_Syntax_Syntax.sigopts) - }) sigelts1 in - if is_typed - then () - else + } + | uu___6 -> se) sigelts in + (FStar_Options.with_saved_options + (fun uu___7 -> FStar_Compiler_List.iter - (fun se -> - FStar_Compiler_List.iter - (fun q -> - let uu___12 = - FStar_Syntax_Syntax.is_internal_qualifier - q in - if uu___12 - then - let uu___13 = - let uu___14 = - let uu___15 = - FStar_Syntax_Print.qual_to_string - q in - let uu___16 = - FStar_Syntax_Print.sigelt_to_string_short - se in - FStar_Compiler_Util.format2 - "The qualifier %s is internal, it cannot be attached to spliced sigelt `%s`." - uu___15 uu___16 in - (FStar_Errors_Codes.Error_InternalQualifier, - uu___14) in - FStar_Errors.raise_error - uu___13 rng - else ()) - se.FStar_Syntax_Syntax.sigquals) - sigelts2; - (match () with | () -> sigelts2))))))))) + (fun g1 -> + (let uu___9 = + FStar_Tactics_Types.goal_opts g1 in + FStar_Options.set uu___9); + (let uu___9 = + let uu___10 = + FStar_Tactics_Types.goal_env g1 in + let uu___11 = + FStar_Tactics_Types.goal_type + g1 in + getprop uu___10 uu___11 in + match uu___9 with + | FStar_Pervasives_Native.Some vc + -> + ((let uu___11 = + FStar_Compiler_Effect.op_Bang + dbg_Tac in + if uu___11 + then + let uu___12 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + vc in + FStar_Compiler_Util.print1 + "Splice left a goal: %s\n" + uu___12 + else ()); + (let guard = + { + FStar_TypeChecker_Common.guard_f + = + (FStar_TypeChecker_Common.NonTrivial + vc); + FStar_TypeChecker_Common.deferred_to_tac + = []; + FStar_TypeChecker_Common.deferred + = []; + FStar_TypeChecker_Common.univ_ineqs + = ([], []); + FStar_TypeChecker_Common.implicits + = [] + } in + let uu___11 = + FStar_Tactics_Types.goal_env + g1 in + FStar_TypeChecker_Rel.force_trivial_guard + uu___11 guard)) + | FStar_Pervasives_Native.None -> + FStar_Errors.raise_error + (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, + "splice left open goals") + rng)) gs); + (let lids' = + FStar_Compiler_List.collect + FStar_Syntax_Util.lids_of_sigelt sigelts1 in + FStar_Compiler_List.iter + (fun lid -> + let uu___8 = + FStar_Compiler_List.tryFind + (FStar_Ident.lid_equals lid) lids' in + match uu___8 with + | FStar_Pervasives_Native.None when + Prims.op_Negation + env.FStar_TypeChecker_Env.nosynth + -> + let uu___9 = + let uu___10 = + let uu___11 = + FStar_Class_Show.show + FStar_Ident.showable_lident + lid in + let uu___12 = + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Ident.showable_lident) + lids' in + FStar_Compiler_Util.format2 + "Splice declared the name %s but it was not defined.\nThose defined were: %s" + uu___11 uu___12 in + (FStar_Errors_Codes.Fatal_SplicedUndef, + uu___10) in + FStar_Errors.raise_error uu___9 rng + | uu___9 -> ()) lids; + (let uu___9 = + FStar_Compiler_Effect.op_Bang dbg_Tac in + if uu___9 + then + let uu___10 = + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Syntax_Print.showable_sigelt) + sigelts1 in + FStar_Compiler_Util.print1 + "splice: got decls = {\n\n%s\n\n}\n" + uu___10 + else ()); + (let sigelts2 = + FStar_Compiler_List.map + (fun se -> + (match se.FStar_Syntax_Syntax.sigel + with + | FStar_Syntax_Syntax.Sig_datacon + uu___10 -> + let uu___11 = + let uu___12 = + let uu___13 = + FStar_Syntax_Print.sigelt_to_string_short + se in + FStar_Compiler_Util.format1 + "Tactic returned bad sigelt: %s\nIf you wanted to splice an inductive type, call `pack` providing a `Sg_Inductive` to get a proper sigelt." + uu___13 in + (FStar_Errors_Codes.Error_BadSplice, + uu___12) in + FStar_Errors.raise_error uu___11 + rng + | FStar_Syntax_Syntax.Sig_inductive_typ + uu___10 -> + let uu___11 = + let uu___12 = + let uu___13 = + FStar_Syntax_Print.sigelt_to_string_short + se in + FStar_Compiler_Util.format1 + "Tactic returned bad sigelt: %s\nIf you wanted to splice an inductive type, call `pack` providing a `Sg_Inductive` to get a proper sigelt." + uu___13 in + (FStar_Errors_Codes.Error_BadSplice, + uu___12) in + FStar_Errors.raise_error uu___11 + rng + | uu___10 -> ()); + { + FStar_Syntax_Syntax.sigel = + (se.FStar_Syntax_Syntax.sigel); + FStar_Syntax_Syntax.sigrng = rng; + FStar_Syntax_Syntax.sigquals = + (se.FStar_Syntax_Syntax.sigquals); + FStar_Syntax_Syntax.sigmeta = + (se.FStar_Syntax_Syntax.sigmeta); + FStar_Syntax_Syntax.sigattrs = + (se.FStar_Syntax_Syntax.sigattrs); + FStar_Syntax_Syntax.sigopens_and_abbrevs + = + (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); + FStar_Syntax_Syntax.sigopts = + (se.FStar_Syntax_Syntax.sigopts) + }) sigelts1 in + if is_typed + then () + else + FStar_Compiler_List.iter + (fun se -> + FStar_Compiler_List.iter + (fun q -> + let uu___11 = + FStar_Syntax_Syntax.is_internal_qualifier + q in + if uu___11 + then + let uu___12 = + let uu___13 = + let uu___14 = + FStar_Syntax_Print.qual_to_string + q in + let uu___15 = + FStar_Syntax_Print.sigelt_to_string_short + se in + FStar_Compiler_Util.format2 + "The qualifier %s is internal, it cannot be attached to spliced sigelt `%s`." + uu___14 uu___15 in + (FStar_Errors_Codes.Error_InternalQualifier, + uu___13) in + FStar_Errors.raise_error + uu___12 rng + else ()) + se.FStar_Syntax_Syntax.sigquals) + sigelts2; + (match () with | () -> sigelts2)))))))) let (mpreprocess : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> @@ -2381,22 +2350,17 @@ let (mpreprocess : if env.FStar_TypeChecker_Env.nosynth then tm else - ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Tac") in - FStar_Compiler_Effect.op_Colon_Equals - FStar_Tactics_Interpreter.tacdbg uu___3); - (let ps = - FStar_Tactics_V2_Basic.proofstate_of_goals - tm.FStar_Syntax_Syntax.pos env [] [] in - let tactic_already_typed = false in - let uu___3 = - FStar_Tactics_Interpreter.run_tactic_on_ps - tau.FStar_Syntax_Syntax.pos tm.FStar_Syntax_Syntax.pos - false FStar_Reflection_V2_Embeddings.e_term tm - FStar_Reflection_V2_Embeddings.e_term tau - tactic_already_typed ps in - match uu___3 with | (gs, tm1) -> tm1))) + (let ps = + FStar_Tactics_V2_Basic.proofstate_of_goals + tm.FStar_Syntax_Syntax.pos env [] [] in + let tactic_already_typed = false in + let uu___2 = + FStar_Tactics_Interpreter.run_tactic_on_ps + tau.FStar_Syntax_Syntax.pos tm.FStar_Syntax_Syntax.pos + false FStar_Reflection_V2_Embeddings.e_term tm + FStar_Reflection_V2_Embeddings.e_term tau + tactic_already_typed ps in + match uu___2 with | (gs, tm1) -> tm1)) let (postprocess : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> @@ -2413,78 +2377,72 @@ let (postprocess : if env.FStar_TypeChecker_Env.nosynth then tm else - ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Tac") in - FStar_Compiler_Effect.op_Colon_Equals - FStar_Tactics_Interpreter.tacdbg uu___3); - (let uu___3 = - FStar_TypeChecker_Env.new_implicit_var_aux - "postprocess RHS" tm.FStar_Syntax_Syntax.pos env typ - (FStar_Syntax_Syntax.Allow_untyped "postprocess") - FStar_Pervasives_Native.None in - match uu___3 with - | (uvtm, uu___4, g_imp) -> - let u = env.FStar_TypeChecker_Env.universe_of env typ in - let goal = - let uu___5 = FStar_Syntax_Util.mk_eq2 u typ tm uvtm in - FStar_Syntax_Util.mk_squash - FStar_Syntax_Syntax.U_zero uu___5 in - let uu___5 = - run_tactic_on_typ tau.FStar_Syntax_Syntax.pos - tm.FStar_Syntax_Syntax.pos tau env goal in - (match uu___5 with - | (gs, w) -> - (FStar_Compiler_List.iter - (fun g -> - let uu___7 = - let uu___8 = - FStar_Tactics_Types.goal_env g in - let uu___9 = - FStar_Tactics_Types.goal_type g in - getprop uu___8 uu___9 in - match uu___7 with - | FStar_Pervasives_Native.Some vc -> - ((let uu___9 = - FStar_Compiler_Effect.op_Bang - FStar_Tactics_Interpreter.tacdbg in - if uu___9 - then - let uu___10 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term - vc in - FStar_Compiler_Util.print1 - "Postprocessing left a goal: %s\n" - uu___10 - else ()); - (let guard = - { - FStar_TypeChecker_Common.guard_f - = - (FStar_TypeChecker_Common.NonTrivial - vc); - FStar_TypeChecker_Common.deferred_to_tac - = []; - FStar_TypeChecker_Common.deferred - = []; - FStar_TypeChecker_Common.univ_ineqs - = ([], []); - FStar_TypeChecker_Common.implicits - = [] - } in - let uu___9 = - FStar_Tactics_Types.goal_env g in - FStar_TypeChecker_Rel.force_trivial_guard - uu___9 guard)) - | FStar_Pervasives_Native.None -> - FStar_Errors.raise_error - (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, - "postprocessing left open goals") - typ.FStar_Syntax_Syntax.pos) gs; - (let tagged_imps = - FStar_TypeChecker_Rel.resolve_implicits_tac - env g_imp in - FStar_Tactics_Interpreter.report_implicits - tm.FStar_Syntax_Syntax.pos tagged_imps; - uvtm)))))) \ No newline at end of file + (let uu___2 = + FStar_TypeChecker_Env.new_implicit_var_aux + "postprocess RHS" tm.FStar_Syntax_Syntax.pos env typ + (FStar_Syntax_Syntax.Allow_untyped "postprocess") + FStar_Pervasives_Native.None in + match uu___2 with + | (uvtm, uu___3, g_imp) -> + let u = env.FStar_TypeChecker_Env.universe_of env typ in + let goal = + let uu___4 = FStar_Syntax_Util.mk_eq2 u typ tm uvtm in + FStar_Syntax_Util.mk_squash + FStar_Syntax_Syntax.U_zero uu___4 in + let uu___4 = + run_tactic_on_typ tau.FStar_Syntax_Syntax.pos + tm.FStar_Syntax_Syntax.pos tau env goal in + (match uu___4 with + | (gs, w) -> + (FStar_Compiler_List.iter + (fun g -> + let uu___6 = + let uu___7 = + FStar_Tactics_Types.goal_env g in + let uu___8 = + FStar_Tactics_Types.goal_type g in + getprop uu___7 uu___8 in + match uu___6 with + | FStar_Pervasives_Native.Some vc -> + ((let uu___8 = + FStar_Compiler_Effect.op_Bang + dbg_Tac in + if uu___8 + then + let uu___9 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + vc in + FStar_Compiler_Util.print1 + "Postprocessing left a goal: %s\n" + uu___9 + else ()); + (let guard = + { + FStar_TypeChecker_Common.guard_f = + (FStar_TypeChecker_Common.NonTrivial + vc); + FStar_TypeChecker_Common.deferred_to_tac + = []; + FStar_TypeChecker_Common.deferred + = []; + FStar_TypeChecker_Common.univ_ineqs + = ([], []); + FStar_TypeChecker_Common.implicits + = [] + } in + let uu___8 = + FStar_Tactics_Types.goal_env g in + FStar_TypeChecker_Rel.force_trivial_guard + uu___8 guard)) + | FStar_Pervasives_Native.None -> + FStar_Errors.raise_error + (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, + "postprocessing left open goals") + typ.FStar_Syntax_Syntax.pos) gs; + (let tagged_imps = + FStar_TypeChecker_Rel.resolve_implicits_tac + env g_imp in + FStar_Tactics_Interpreter.report_implicits + tm.FStar_Syntax_Syntax.pos tagged_imps; + uvtm))))) \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Interpreter.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Interpreter.ml index 110a60836f8..b282ec92678 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Interpreter.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Interpreter.ml @@ -1,7 +1,7 @@ open Prims +let (dbg_Tac : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Tac" let solve : 'a . 'a -> 'a = fun ev -> ev -let (tacdbg : Prims.bool FStar_Compiler_Effect.ref) = - FStar_Compiler_Util.mk_ref false let embed : 'a . 'a FStar_Syntax_Embeddings_Base.embedding -> @@ -929,11 +929,11 @@ let run_unembedded_tactic_on_ps : let uu___2 = tau arg in FStar_Tactics_Monad.run_safe uu___2 ps2) uu___ "FStar.Tactics.Interpreter.run_safe" in - (let uu___1 = FStar_Compiler_Effect.op_Bang tacdbg in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___1 then FStar_Compiler_Util.print_string "}\n" else ()); (match res with | FStar_Tactics_Result.Success (ret, ps3) -> - ((let uu___2 = FStar_Compiler_Effect.op_Bang tacdbg in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___2 then FStar_Tactics_Printing.do_dump_proofstate ps3 @@ -951,7 +951,7 @@ let run_unembedded_tactic_on_ps : if uu___4 then ((let uu___6 = - FStar_Compiler_Effect.op_Bang tacdbg in + FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___6 then let uu___7 = @@ -986,7 +986,7 @@ let run_unembedded_tactic_on_ps : FStar_Errors.with_ctx "While checking implicits left by a tactic" (fun uu___4 -> - (let uu___6 = FStar_Compiler_Effect.op_Bang tacdbg in + (let uu___6 = FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___6 then let uu___7 = @@ -1015,7 +1015,8 @@ let run_unembedded_tactic_on_ps : let g1 = FStar_TypeChecker_Rel.solve_deferred_constraints env g in - (let uu___7 = FStar_Compiler_Effect.op_Bang tacdbg in + (let uu___7 = + FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___7 then let uu___8 = @@ -1037,7 +1038,7 @@ let run_unembedded_tactic_on_ps : FStar_TypeChecker_Rel.resolve_implicits_tac env g1 in (let uu___8 = - FStar_Compiler_Effect.op_Bang tacdbg in + FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___8 then let uu___9 = @@ -1131,7 +1132,7 @@ let run_tactic_on_ps' : fun tactic_already_typed -> fun ps -> let env = ps.FStar_Tactics_Types.main_context in - (let uu___1 = FStar_Compiler_Effect.op_Bang tacdbg in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___1 then let uu___2 = @@ -1158,7 +1159,7 @@ let run_tactic_on_ps' : FStar_TypeChecker_TcTerm.tc_tactic uu___3 uu___4 env tactic in match uu___2 with | (uu___3, uu___4, g1) -> g1) in - (let uu___2 = FStar_Compiler_Effect.op_Bang tacdbg in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___2 then FStar_Compiler_Util.print_string "}\n" else ()); diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Monad.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Monad.ml index 85b7c484257..a6e87dc59d1 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Monad.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Monad.ml @@ -1,4 +1,12 @@ open Prims +let (dbg_Core : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Core" +let (dbg_CoreEq : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "CoreEq" +let (dbg_RegisterGoal : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "RegisterGoal" +let (dbg_TacFail : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "TacFail" let (goal_ctr : Prims.int FStar_Compiler_Effect.ref) = FStar_Compiler_Util.mk_ref Prims.int_zero let (get_goal_ctr : unit -> Prims.int) = @@ -153,9 +161,7 @@ let (register_goal : FStar_Tactics_Types.goal -> unit) = FStar_TypeChecker_Env.core_check = (env.FStar_TypeChecker_Env.core_check) } in - (let uu___6 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "CoreEq") in + (let uu___6 = FStar_Compiler_Effect.op_Bang dbg_CoreEq in if uu___6 then let uu___7 = @@ -168,11 +174,8 @@ let (register_goal : FStar_Tactics_Types.goal -> unit) = if Prims.op_Negation should_register then let uu___7 = - (FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "Core")) - || - (FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "RegisterGoal")) in + (FStar_Compiler_Effect.op_Bang dbg_Core) || + (FStar_Compiler_Effect.op_Bang dbg_RegisterGoal) in (if uu___7 then let uu___8 = @@ -185,11 +188,8 @@ let (register_goal : FStar_Tactics_Types.goal -> unit) = else ()) else ((let uu___8 = - (FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "Core")) - || - (FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "RegisterGoal")) in + (FStar_Compiler_Effect.op_Bang dbg_Core) || + (FStar_Compiler_Effect.op_Bang dbg_RegisterGoal) in if uu___8 then let uu___9 = @@ -291,9 +291,7 @@ let fail_doc : 'a . FStar_Errors_Msg.error_message -> 'a tac = fun msg -> mk_tac (fun ps -> - (let uu___1 = - FStar_TypeChecker_Env.debug ps.FStar_Tactics_Types.main_context - (FStar_Options.Other "TacFail") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_TacFail in if uu___1 then let uu___2 = diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Printing.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Printing.ml index 8f69ca5ba52..433c69f2d5d 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Printing.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Printing.ml @@ -1,4 +1,6 @@ open Prims +let (dbg_Imp : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Imp" let (term_to_string : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> Prims.string) = fun e -> @@ -230,10 +232,7 @@ let (ps_to_string : else "" in let uu___6 = let uu___7 = - let uu___8 = - FStar_TypeChecker_Env.debug - ps.FStar_Tactics_Types.main_context - (FStar_Options.Other "Imp") in + let uu___8 = FStar_Compiler_Effect.op_Bang dbg_Imp in if uu___8 then let uu___9 = diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml index b0786a86398..96167d0b5a5 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml @@ -1,4 +1,12 @@ open Prims +let (dbg_2635 : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "2635" +let (dbg_ReflTc : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ReflTc" +let (dbg_Tac : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Tac" +let (dbg_TacUnify : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "TacUnify" let ret : 'a . 'a -> 'a FStar_Tactics_Monad.tac = fun uu___ -> (fun x -> @@ -51,7 +59,7 @@ let (core_check : then FStar_Pervasives.Inl FStar_Pervasives_Native.None else (let debug f = - let uu___2 = FStar_Options.debug_any () in + let uu___2 = FStar_Compiler_Debug.any () in if uu___2 then f () else () in let uu___2 = FStar_TypeChecker_Core.check_term env sol t must_tot in @@ -190,10 +198,7 @@ let (debugging : unit -> Prims.bool FStar_Tactics_Monad.tac) = let uu___1 = bind () in uu___1 FStar_Tactics_Monad.get (fun ps -> - let uu___2 = - FStar_TypeChecker_Env.debug ps.FStar_Tactics_Types.main_context - (FStar_Options.Other "Tac") in - ret uu___2) + let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Tac in ret uu___2) let (do_dump_ps : Prims.string -> FStar_Tactics_Types.proofstate -> unit) = fun msg -> fun ps -> @@ -1131,27 +1136,28 @@ let (__do_unify : fun env1 -> fun t1 -> fun t2 -> - let dbg = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "TacUnify") in let uu___ = bind () in uu___ idtac (fun uu___1 -> - if dbg - then - (FStar_Options.push (); - (let uu___4 = - FStar_Options.set_options - "--debug_level Rel --debug_level RelCheck" in - ())) - else (); + (let uu___3 = FStar_Compiler_Effect.op_Bang dbg_TacUnify in + if uu___3 + then + (FStar_Options.push (); + (let uu___5 = + FStar_Options.set_options "--debug Rel,RelCheck" in + ())) + else ()); (let uu___3 = - __do_unify_wflags dbg allow_guards must_tot check_side - env1 t1 t2 in + let uu___4 = FStar_Compiler_Effect.op_Bang dbg_TacUnify in + __do_unify_wflags uu___4 allow_guards must_tot + check_side env1 t1 t2 in let uu___4 = bind () in uu___4 uu___3 (fun r -> - if dbg then FStar_Options.pop () else (); ret r))) + (let uu___6 = + FStar_Compiler_Effect.op_Bang dbg_TacUnify in + if uu___6 then FStar_Options.pop () else ()); + ret r))) let (do_unify_aux : Prims.bool -> check_unifier_solved_implicits_side -> @@ -4060,10 +4066,10 @@ let (t_apply_lemma : (( let uu___19 = - FStar_TypeChecker_Env.debug - env1 - (FStar_Options.Other - "2635") in + (FStar_Compiler_Debug.medium + ()) || + (FStar_Compiler_Effect.op_Bang + dbg_2635) in if uu___19 then @@ -9365,8 +9371,7 @@ let (free_uvars : let (dbg_refl : env -> (unit -> Prims.string) -> unit) = fun g -> fun msg -> - let uu___ = - FStar_TypeChecker_Env.debug g (FStar_Options.Other "ReflTc") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg_ReflTc in if uu___ then let uu___1 = msg () in FStar_Compiler_Util.print_string uu___1 else () diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V1_Derived.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V1_Derived.ml index c572860bd14..2229ca26f9d 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V1_Derived.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V1_Derived.ml @@ -458,12 +458,12 @@ let (debug : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (143)) (Prims.of_int (7)) (Prims.of_int (143)) + (Prims.of_int (142)) (Prims.of_int (7)) (Prims.of_int (142)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (143)) (Prims.of_int (4)) (Prims.of_int (143)) + (Prims.of_int (142)) (Prims.of_int (4)) (Prims.of_int (142)) (Prims.of_int (32))))) (Obj.magic (FStar_Tactics_V1_Builtins.debugging ())) (fun uu___ -> @@ -481,25 +481,25 @@ let (smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (150)) (Prims.of_int (10)) (Prims.of_int (150)) + (Prims.of_int (149)) (Prims.of_int (10)) (Prims.of_int (149)) (Prims.of_int (32))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (150)) (Prims.of_int (4)) (Prims.of_int (156)) + (Prims.of_int (149)) (Prims.of_int (4)) (Prims.of_int (155)) (Prims.of_int (11))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (150)) (Prims.of_int (10)) - (Prims.of_int (150)) (Prims.of_int (18))))) + (Prims.of_int (149)) (Prims.of_int (10)) + (Prims.of_int (149)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (150)) (Prims.of_int (10)) - (Prims.of_int (150)) (Prims.of_int (32))))) + (Prims.of_int (149)) (Prims.of_int (10)) + (Prims.of_int (149)) (Prims.of_int (32))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -509,14 +509,14 @@ let (smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (150)) (Prims.of_int (20)) - (Prims.of_int (150)) (Prims.of_int (32))))) + (Prims.of_int (149)) (Prims.of_int (20)) + (Prims.of_int (149)) (Prims.of_int (32))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (150)) (Prims.of_int (10)) - (Prims.of_int (150)) (Prims.of_int (32))))) + (Prims.of_int (149)) (Prims.of_int (10)) + (Prims.of_int (149)) (Prims.of_int (32))))) (Obj.magic (smt_goals ())) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -534,14 +534,14 @@ let (smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (154)) (Prims.of_int (8)) - (Prims.of_int (154)) (Prims.of_int (20))))) + (Prims.of_int (153)) (Prims.of_int (8)) + (Prims.of_int (153)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (155)) (Prims.of_int (8)) - (Prims.of_int (155)) (Prims.of_int (32))))) + (Prims.of_int (154)) (Prims.of_int (8)) + (Prims.of_int (154)) (Prims.of_int (32))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_goals gs)) (fun uu___2 -> (fun uu___2 -> @@ -559,12 +559,12 @@ let (later : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (162)) (Prims.of_int (10)) (Prims.of_int (162)) + (Prims.of_int (161)) (Prims.of_int (10)) (Prims.of_int (161)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (162)) (Prims.of_int (4)) (Prims.of_int (164)) + (Prims.of_int (161)) (Prims.of_int (4)) (Prims.of_int (163)) (Prims.of_int (33))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -616,12 +616,12 @@ let (t_pointwise : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (223)) (Prims.of_int (4)) (Prims.of_int (223)) + (Prims.of_int (222)) (Prims.of_int (4)) (Prims.of_int (222)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (224)) (Prims.of_int (4)) (Prims.of_int (228)) + (Prims.of_int (223)) (Prims.of_int (4)) (Prims.of_int (227)) (Prims.of_int (24))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> @@ -639,13 +639,13 @@ let (t_pointwise : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (226)) (Prims.of_int (4)) - (Prims.of_int (226)) (Prims.of_int (10))))) + (Prims.of_int (225)) (Prims.of_int (4)) + (Prims.of_int (225)) (Prims.of_int (10))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (228)) (Prims.of_int (2)) - (Prims.of_int (228)) (Prims.of_int (24))))) + (Prims.of_int (227)) (Prims.of_int (2)) + (Prims.of_int (227)) (Prims.of_int (24))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> fun uu___1 -> tau ())) (fun uu___ -> @@ -666,12 +666,12 @@ let (topdown_rewrite : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (252)) (Prims.of_int (49)) - (Prims.of_int (261)) (Prims.of_int (10))))) + (Prims.of_int (251)) (Prims.of_int (49)) + (Prims.of_int (260)) (Prims.of_int (10))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (263)) (Prims.of_int (4)) (Prims.of_int (263)) + (Prims.of_int (262)) (Prims.of_int (4)) (Prims.of_int (262)) (Prims.of_int (33))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> @@ -680,13 +680,13 @@ let (topdown_rewrite : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (253)) (Prims.of_int (17)) - (Prims.of_int (253)) (Prims.of_int (23))))) + (Prims.of_int (252)) (Prims.of_int (17)) + (Prims.of_int (252)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (252)) (Prims.of_int (49)) - (Prims.of_int (261)) (Prims.of_int (10))))) + (Prims.of_int (251)) (Prims.of_int (49)) + (Prims.of_int (260)) (Prims.of_int (10))))) (Obj.magic (ctrl t)) (fun uu___1 -> (fun uu___1 -> @@ -698,17 +698,17 @@ let (topdown_rewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (255)) + (Prims.of_int (254)) (Prims.of_int (8)) - (Prims.of_int (259)) + (Prims.of_int (258)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (261)) + (Prims.of_int (260)) (Prims.of_int (6)) - (Prims.of_int (261)) + (Prims.of_int (260)) (Prims.of_int (10))))) (match i with | uu___2 when uu___2 = Prims.int_zero -> @@ -751,12 +751,12 @@ let (cur_module : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (269)) (Prims.of_int (13)) (Prims.of_int (269)) + (Prims.of_int (268)) (Prims.of_int (13)) (Prims.of_int (268)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (269)) (Prims.of_int (4)) (Prims.of_int (269)) + (Prims.of_int (268)) (Prims.of_int (4)) (Prims.of_int (268)) (Prims.of_int (25))))) (Obj.magic (FStar_Tactics_V1_Builtins.top_env ())) (fun uu___1 -> @@ -772,12 +772,12 @@ let (open_modules : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (272)) (Prims.of_int (21)) (Prims.of_int (272)) + (Prims.of_int (271)) (Prims.of_int (21)) (Prims.of_int (271)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (272)) (Prims.of_int (4)) (Prims.of_int (272)) + (Prims.of_int (271)) (Prims.of_int (4)) (Prims.of_int (271)) (Prims.of_int (33))))) (Obj.magic (FStar_Tactics_V1_Builtins.top_env ())) (fun uu___1 -> @@ -793,12 +793,12 @@ let (fresh_uvar : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (275)) (Prims.of_int (12)) (Prims.of_int (275)) + (Prims.of_int (274)) (Prims.of_int (12)) (Prims.of_int (274)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (276)) (Prims.of_int (4)) (Prims.of_int (276)) + (Prims.of_int (275)) (Prims.of_int (4)) (Prims.of_int (275)) (Prims.of_int (16))))) (Obj.magic (cur_env ())) (fun uu___ -> (fun e -> Obj.magic (FStar_Tactics_V1_Builtins.uvar_env e o)) uu___) @@ -813,12 +813,12 @@ let (unify : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (279)) (Prims.of_int (12)) - (Prims.of_int (279)) (Prims.of_int (22))))) + (Prims.of_int (278)) (Prims.of_int (12)) + (Prims.of_int (278)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (280)) (Prims.of_int (4)) (Prims.of_int (280)) + (Prims.of_int (279)) (Prims.of_int (4)) (Prims.of_int (279)) (Prims.of_int (21))))) (Obj.magic (cur_env ())) (fun uu___ -> (fun e -> Obj.magic (FStar_Tactics_V1_Builtins.unify_env e t1 t2)) @@ -834,12 +834,12 @@ let (unify_guard : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (283)) (Prims.of_int (12)) - (Prims.of_int (283)) (Prims.of_int (22))))) + (Prims.of_int (282)) (Prims.of_int (12)) + (Prims.of_int (282)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (284)) (Prims.of_int (4)) (Prims.of_int (284)) + (Prims.of_int (283)) (Prims.of_int (4)) (Prims.of_int (283)) (Prims.of_int (27))))) (Obj.magic (cur_env ())) (fun uu___ -> (fun e -> @@ -856,12 +856,12 @@ let (tmatch : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (287)) (Prims.of_int (12)) - (Prims.of_int (287)) (Prims.of_int (22))))) + (Prims.of_int (286)) (Prims.of_int (12)) + (Prims.of_int (286)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (288)) (Prims.of_int (4)) (Prims.of_int (288)) + (Prims.of_int (287)) (Prims.of_int (4)) (Prims.of_int (287)) (Prims.of_int (21))))) (Obj.magic (cur_env ())) (fun uu___ -> (fun e -> Obj.magic (FStar_Tactics_V1_Builtins.match_env e t1 t2)) @@ -880,13 +880,13 @@ let divide : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (294)) (Prims.of_int (4)) - (Prims.of_int (295)) (Prims.of_int (31))))) + (Prims.of_int (293)) (Prims.of_int (4)) + (Prims.of_int (294)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (295)) (Prims.of_int (32)) - (Prims.of_int (308)) (Prims.of_int (10))))) + (Prims.of_int (294)) (Prims.of_int (32)) + (Prims.of_int (307)) (Prims.of_int (10))))) (if n < Prims.int_zero then fail "divide: negative n" else FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())) @@ -898,28 +898,28 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (296)) (Prims.of_int (18)) - (Prims.of_int (296)) (Prims.of_int (40))))) + (Prims.of_int (295)) (Prims.of_int (18)) + (Prims.of_int (295)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (295)) (Prims.of_int (32)) - (Prims.of_int (308)) (Prims.of_int (10))))) + (Prims.of_int (294)) (Prims.of_int (32)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (296)) (Prims.of_int (18)) - (Prims.of_int (296)) (Prims.of_int (26))))) + (Prims.of_int (295)) (Prims.of_int (18)) + (Prims.of_int (295)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (296)) (Prims.of_int (18)) - (Prims.of_int (296)) (Prims.of_int (40))))) + (Prims.of_int (295)) (Prims.of_int (18)) + (Prims.of_int (295)) (Prims.of_int (40))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -929,17 +929,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (296)) + (Prims.of_int (295)) (Prims.of_int (28)) - (Prims.of_int (296)) + (Prims.of_int (295)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (296)) + (Prims.of_int (295)) (Prims.of_int (18)) - (Prims.of_int (296)) + (Prims.of_int (295)) (Prims.of_int (40))))) (Obj.magic (smt_goals ())) (fun uu___2 -> @@ -956,17 +956,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (297)) + (Prims.of_int (296)) (Prims.of_int (19)) - (Prims.of_int (297)) + (Prims.of_int (296)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (296)) + (Prims.of_int (295)) (Prims.of_int (43)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> @@ -981,17 +981,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (299)) + (Prims.of_int (298)) (Prims.of_int (4)) - (Prims.of_int (299)) + (Prims.of_int (298)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (299)) + (Prims.of_int (298)) (Prims.of_int (19)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_goals @@ -1005,18 +1005,18 @@ let divide : ( FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (299)) + (Prims.of_int (298)) (Prims.of_int (19)) - (Prims.of_int (299)) + (Prims.of_int (298)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic ( FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (299)) + (Prims.of_int (298)) (Prims.of_int (36)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_smt_goals @@ -1030,17 +1030,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (300)) + (Prims.of_int (299)) (Prims.of_int (12)) - (Prims.of_int (300)) + (Prims.of_int (299)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (300)) + (Prims.of_int (299)) (Prims.of_int (19)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (l ())) @@ -1053,17 +1053,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (20)) - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (300)) + (Prims.of_int (299)) (Prims.of_int (19)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1071,17 +1071,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (20)) - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (20)) - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (42))))) (Obj.magic (goals ())) @@ -1095,17 +1095,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (30)) - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (20)) - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (42))))) (Obj.magic (smt_goals @@ -1133,17 +1133,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (303)) + (Prims.of_int (302)) (Prims.of_int (4)) - (Prims.of_int (303)) + (Prims.of_int (302)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (303)) + (Prims.of_int (302)) (Prims.of_int (19)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_goals @@ -1158,17 +1158,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (303)) + (Prims.of_int (302)) (Prims.of_int (19)) - (Prims.of_int (303)) + (Prims.of_int (302)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (303)) + (Prims.of_int (302)) (Prims.of_int (36)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_smt_goals @@ -1183,17 +1183,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (304)) + (Prims.of_int (303)) (Prims.of_int (12)) - (Prims.of_int (304)) + (Prims.of_int (303)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (304)) + (Prims.of_int (303)) (Prims.of_int (19)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (r ())) @@ -1206,17 +1206,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (20)) - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (304)) + (Prims.of_int (303)) (Prims.of_int (19)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1224,17 +1224,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (20)) - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (20)) - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (42))))) (Obj.magic (goals ())) @@ -1248,17 +1248,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (30)) - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (20)) - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (42))))) (Obj.magic (smt_goals @@ -1287,17 +1287,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (307)) + (Prims.of_int (306)) (Prims.of_int (4)) - (Prims.of_int (307)) + (Prims.of_int (306)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (307)) + (Prims.of_int (306)) (Prims.of_int (27)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_goals @@ -1314,17 +1314,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (307)) + (Prims.of_int (306)) (Prims.of_int (27)) - (Prims.of_int (307)) + (Prims.of_int (306)) (Prims.of_int (60))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (4)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_smt_goals @@ -1364,13 +1364,13 @@ let rec (iseq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (312)) (Prims.of_int (23)) - (Prims.of_int (312)) (Prims.of_int (53))))) + (Prims.of_int (311)) (Prims.of_int (23)) + (Prims.of_int (311)) (Prims.of_int (53))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (312)) (Prims.of_int (57)) - (Prims.of_int (312)) (Prims.of_int (59))))) + (Prims.of_int (311)) (Prims.of_int (57)) + (Prims.of_int (311)) (Prims.of_int (59))))) (Obj.magic (divide Prims.int_one t (fun uu___ -> iseq ts1))) (fun uu___ -> @@ -1389,12 +1389,12 @@ let focus : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (318)) (Prims.of_int (10)) (Prims.of_int (318)) + (Prims.of_int (317)) (Prims.of_int (10)) (Prims.of_int (317)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (318)) (Prims.of_int (4)) (Prims.of_int (325)) + (Prims.of_int (317)) (Prims.of_int (4)) (Prims.of_int (324)) (Prims.of_int (9))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -1408,14 +1408,14 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (321)) (Prims.of_int (18)) - (Prims.of_int (321)) (Prims.of_int (30))))) + (Prims.of_int (320)) (Prims.of_int (18)) + (Prims.of_int (320)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (322)) (Prims.of_int (8)) - (Prims.of_int (325)) (Prims.of_int (9))))) + (Prims.of_int (321)) (Prims.of_int (8)) + (Prims.of_int (324)) (Prims.of_int (9))))) (Obj.magic (smt_goals ())) (fun uu___1 -> (fun sgs -> @@ -1425,17 +1425,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (8)) - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (23)) - (Prims.of_int (325)) + (Prims.of_int (324)) (Prims.of_int (9))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_goals @@ -1448,17 +1448,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (23)) - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (40)) - (Prims.of_int (325)) + (Prims.of_int (324)) (Prims.of_int (9))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_smt_goals @@ -1471,17 +1471,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (323)) + (Prims.of_int (322)) (Prims.of_int (16)) - (Prims.of_int (323)) + (Prims.of_int (322)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (8)) - (Prims.of_int (325)) + (Prims.of_int (324)) (Prims.of_int (9))))) (Obj.magic (t ())) (fun uu___3 -> @@ -1493,18 +1493,18 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (8)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (33))))) ( FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (35)) - (Prims.of_int (325)) + (Prims.of_int (324)) (Prims.of_int (9))))) ( Obj.magic @@ -1513,17 +1513,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (18)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (8)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (33))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1531,17 +1531,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (19)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (18)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (33))))) (Obj.magic (goals ())) @@ -1571,17 +1571,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (35)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (69))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (323)) + (Prims.of_int (322)) (Prims.of_int (12)) - (Prims.of_int (323)) + (Prims.of_int (322)) (Prims.of_int (13))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1589,17 +1589,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (49)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (69))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (35)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (69))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1607,17 +1607,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (50)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (62))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (49)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (69))))) (Obj.magic (smt_goals @@ -1660,12 +1660,12 @@ let rec mapAll : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (331)) (Prims.of_int (10)) (Prims.of_int (331)) + (Prims.of_int (330)) (Prims.of_int (10)) (Prims.of_int (330)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (331)) (Prims.of_int (4)) (Prims.of_int (333)) + (Prims.of_int (330)) (Prims.of_int (4)) (Prims.of_int (332)) (Prims.of_int (66))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -1682,14 +1682,14 @@ let rec mapAll : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (333)) (Prims.of_int (27)) - (Prims.of_int (333)) (Prims.of_int (58))))) + (Prims.of_int (332)) (Prims.of_int (27)) + (Prims.of_int (332)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (333)) (Prims.of_int (13)) - (Prims.of_int (333)) (Prims.of_int (66))))) + (Prims.of_int (332)) (Prims.of_int (13)) + (Prims.of_int (332)) (Prims.of_int (66))))) (Obj.magic (divide Prims.int_one t (fun uu___3 -> mapAll t))) (fun uu___3 -> @@ -1706,12 +1706,12 @@ let rec (iterAll : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (337)) (Prims.of_int (10)) (Prims.of_int (337)) + (Prims.of_int (336)) (Prims.of_int (10)) (Prims.of_int (336)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (337)) (Prims.of_int (4)) (Prims.of_int (339)) + (Prims.of_int (336)) (Prims.of_int (4)) (Prims.of_int (338)) (Prims.of_int (60))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -1728,14 +1728,14 @@ let rec (iterAll : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (339)) (Prims.of_int (22)) - (Prims.of_int (339)) (Prims.of_int (54))))) + (Prims.of_int (338)) (Prims.of_int (22)) + (Prims.of_int (338)) (Prims.of_int (54))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (339)) (Prims.of_int (58)) - (Prims.of_int (339)) (Prims.of_int (60))))) + (Prims.of_int (338)) (Prims.of_int (58)) + (Prims.of_int (338)) (Prims.of_int (60))))) (Obj.magic (divide Prims.int_one t (fun uu___3 -> iterAll t))) (fun uu___3 -> @@ -1750,25 +1750,25 @@ let (iterAllSMT : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (342)) (Prims.of_int (18)) (Prims.of_int (342)) + (Prims.of_int (341)) (Prims.of_int (18)) (Prims.of_int (341)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (341)) (Prims.of_int (50)) (Prims.of_int (348)) + (Prims.of_int (340)) (Prims.of_int (50)) (Prims.of_int (347)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (342)) (Prims.of_int (18)) - (Prims.of_int (342)) (Prims.of_int (26))))) + (Prims.of_int (341)) (Prims.of_int (18)) + (Prims.of_int (341)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (342)) (Prims.of_int (18)) - (Prims.of_int (342)) (Prims.of_int (40))))) + (Prims.of_int (341)) (Prims.of_int (18)) + (Prims.of_int (341)) (Prims.of_int (40))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -1778,14 +1778,14 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (342)) (Prims.of_int (28)) - (Prims.of_int (342)) (Prims.of_int (40))))) + (Prims.of_int (341)) (Prims.of_int (28)) + (Prims.of_int (341)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (342)) (Prims.of_int (18)) - (Prims.of_int (342)) (Prims.of_int (40))))) + (Prims.of_int (341)) (Prims.of_int (18)) + (Prims.of_int (341)) (Prims.of_int (40))))) (Obj.magic (smt_goals ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -1800,14 +1800,14 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (343)) (Prims.of_int (4)) - (Prims.of_int (343)) (Prims.of_int (17))))) + (Prims.of_int (342)) (Prims.of_int (4)) + (Prims.of_int (342)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (344)) (Prims.of_int (4)) - (Prims.of_int (348)) (Prims.of_int (28))))) + (Prims.of_int (343)) (Prims.of_int (4)) + (Prims.of_int (347)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_goals sgs)) (fun uu___1 -> (fun uu___1 -> @@ -1817,17 +1817,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (344)) + (Prims.of_int (343)) (Prims.of_int (4)) - (Prims.of_int (344)) + (Prims.of_int (343)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (345)) + (Prims.of_int (344)) (Prims.of_int (4)) - (Prims.of_int (348)) + (Prims.of_int (347)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_smt_goals @@ -1840,17 +1840,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (345)) + (Prims.of_int (344)) (Prims.of_int (4)) - (Prims.of_int (345)) + (Prims.of_int (344)) (Prims.of_int (13))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (345)) + (Prims.of_int (344)) (Prims.of_int (14)) - (Prims.of_int (348)) + (Prims.of_int (347)) (Prims.of_int (28))))) (Obj.magic (iterAll t)) (fun uu___3 -> @@ -1861,17 +1861,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (20)) - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (345)) + (Prims.of_int (344)) (Prims.of_int (14)) - (Prims.of_int (348)) + (Prims.of_int (347)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1879,17 +1879,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (20)) - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (20)) - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (42))))) (Obj.magic (goals ())) @@ -1902,17 +1902,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (30)) - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (20)) - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (42))))) (Obj.magic (smt_goals @@ -1935,17 +1935,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (347)) + (Prims.of_int (346)) (Prims.of_int (4)) - (Prims.of_int (347)) + (Prims.of_int (346)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (348)) + (Prims.of_int (347)) (Prims.of_int (4)) - (Prims.of_int (348)) + (Prims.of_int (347)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_goals @@ -1975,13 +1975,13 @@ let (seq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (354)) (Prims.of_int (21)) - (Prims.of_int (354)) (Prims.of_int (25))))) + (Prims.of_int (353)) (Prims.of_int (21)) + (Prims.of_int (353)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (354)) (Prims.of_int (27)) - (Prims.of_int (354)) (Prims.of_int (36))))) + (Prims.of_int (353)) (Prims.of_int (27)) + (Prims.of_int (353)) (Prims.of_int (36))))) (Obj.magic (f ())) (fun uu___1 -> (fun uu___1 -> Obj.magic (iterAll g)) uu___1)) let (exact_args : @@ -1996,13 +1996,13 @@ let (exact_args : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (358)) (Prims.of_int (16)) - (Prims.of_int (358)) (Prims.of_int (39))))) + (Prims.of_int (357)) (Prims.of_int (16)) + (Prims.of_int (357)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (358)) (Prims.of_int (42)) - (Prims.of_int (364)) (Prims.of_int (44))))) + (Prims.of_int (357)) (Prims.of_int (42)) + (Prims.of_int (363)) (Prims.of_int (44))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> FStar_List_Tot_Base.length qs)) (fun uu___1 -> @@ -2013,14 +2013,14 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (359)) (Prims.of_int (18)) - (Prims.of_int (359)) (Prims.of_int (55))))) + (Prims.of_int (358)) (Prims.of_int (18)) + (Prims.of_int (358)) (Prims.of_int (55))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (359)) (Prims.of_int (58)) - (Prims.of_int (364)) (Prims.of_int (44))))) + (Prims.of_int (358)) (Prims.of_int (58)) + (Prims.of_int (363)) (Prims.of_int (44))))) (Obj.magic (FStar_Tactics_Util.repeatn n (fun uu___1 -> @@ -2033,17 +2033,17 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (360)) + (Prims.of_int (359)) (Prims.of_int (17)) - (Prims.of_int (360)) + (Prims.of_int (359)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (361)) + (Prims.of_int (360)) (Prims.of_int (8)) - (Prims.of_int (364)) + (Prims.of_int (363)) (Prims.of_int (44))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2051,17 +2051,17 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (360)) + (Prims.of_int (359)) (Prims.of_int (26)) - (Prims.of_int (360)) + (Prims.of_int (359)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (360)) + (Prims.of_int (359)) (Prims.of_int (17)) - (Prims.of_int (360)) + (Prims.of_int (359)) (Prims.of_int (38))))) (Obj.magic (FStar_Tactics_Util.zip uvs qs)) @@ -2078,17 +2078,17 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (361)) + (Prims.of_int (360)) (Prims.of_int (8)) - (Prims.of_int (361)) + (Prims.of_int (360)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (362)) + (Prims.of_int (361)) (Prims.of_int (8)) - (Prims.of_int (364)) + (Prims.of_int (363)) (Prims.of_int (44))))) (Obj.magic (exact t')) (fun uu___1 -> @@ -2126,12 +2126,12 @@ let (exact_n : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (368)) (Prims.of_int (15)) - (Prims.of_int (368)) (Prims.of_int (49))))) + (Prims.of_int (367)) (Prims.of_int (15)) + (Prims.of_int (367)) (Prims.of_int (49))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (368)) (Prims.of_int (4)) (Prims.of_int (368)) + (Prims.of_int (367)) (Prims.of_int (4)) (Prims.of_int (367)) (Prims.of_int (51))))) (Obj.magic (FStar_Tactics_Util.repeatn n @@ -2148,12 +2148,12 @@ let (ngoals : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (371)) (Prims.of_int (47)) (Prims.of_int (371)) + (Prims.of_int (370)) (Prims.of_int (47)) (Prims.of_int (370)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (371)) (Prims.of_int (26)) (Prims.of_int (371)) + (Prims.of_int (370)) (Prims.of_int (26)) (Prims.of_int (370)) (Prims.of_int (57))))) (Obj.magic (goals ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2164,12 +2164,12 @@ let (ngoals_smt : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (374)) (Prims.of_int (51)) (Prims.of_int (374)) + (Prims.of_int (373)) (Prims.of_int (51)) (Prims.of_int (373)) (Prims.of_int (65))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (374)) (Prims.of_int (30)) (Prims.of_int (374)) + (Prims.of_int (373)) (Prims.of_int (30)) (Prims.of_int (373)) (Prims.of_int (65))))) (Obj.magic (smt_goals ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2181,12 +2181,12 @@ let (fresh_bv : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (382)) (Prims.of_int (12)) (Prims.of_int (382)) + (Prims.of_int (381)) (Prims.of_int (12)) (Prims.of_int (381)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (383)) (Prims.of_int (4)) (Prims.of_int (383)) + (Prims.of_int (382)) (Prims.of_int (4)) (Prims.of_int (382)) (Prims.of_int (42))))) (Obj.magic (FStar_Tactics_V1_Builtins.fresh ())) (fun uu___1 -> @@ -2205,12 +2205,12 @@ let (fresh_binder_named : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (386)) (Prims.of_int (14)) - (Prims.of_int (386)) (Prims.of_int (33))))) + (Prims.of_int (385)) (Prims.of_int (14)) + (Prims.of_int (385)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (386)) (Prims.of_int (4)) (Prims.of_int (386)) + (Prims.of_int (385)) (Prims.of_int (4)) (Prims.of_int (385)) (Prims.of_int (35))))) (Obj.magic (FStar_Tactics_V1_Builtins.fresh_bv_named nm)) (fun uu___ -> @@ -2225,12 +2225,12 @@ let (fresh_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (390)) (Prims.of_int (12)) (Prims.of_int (390)) + (Prims.of_int (389)) (Prims.of_int (12)) (Prims.of_int (389)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (391)) (Prims.of_int (4)) (Prims.of_int (391)) + (Prims.of_int (390)) (Prims.of_int (4)) (Prims.of_int (390)) (Prims.of_int (48))))) (Obj.magic (FStar_Tactics_V1_Builtins.fresh ())) (fun uu___ -> @@ -2249,12 +2249,12 @@ let (fresh_implicit_binder_named : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (394)) (Prims.of_int (23)) - (Prims.of_int (394)) (Prims.of_int (42))))) + (Prims.of_int (393)) (Prims.of_int (23)) + (Prims.of_int (393)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (394)) (Prims.of_int (4)) (Prims.of_int (394)) + (Prims.of_int (393)) (Prims.of_int (4)) (Prims.of_int (393)) (Prims.of_int (44))))) (Obj.magic (FStar_Tactics_V1_Builtins.fresh_bv_named nm)) (fun uu___ -> @@ -2270,12 +2270,12 @@ let (fresh_implicit_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (398)) (Prims.of_int (12)) (Prims.of_int (398)) + (Prims.of_int (397)) (Prims.of_int (12)) (Prims.of_int (397)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (399)) (Prims.of_int (4)) (Prims.of_int (399)) + (Prims.of_int (398)) (Prims.of_int (4)) (Prims.of_int (398)) (Prims.of_int (57))))) (Obj.magic (FStar_Tactics_V1_Builtins.fresh ())) (fun uu___ -> @@ -2302,12 +2302,12 @@ let try_with : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (412)) (Prims.of_int (10)) - (Prims.of_int (412)) (Prims.of_int (17))))) + (Prims.of_int (411)) (Prims.of_int (10)) + (Prims.of_int (411)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (412)) (Prims.of_int (4)) (Prims.of_int (414)) + (Prims.of_int (411)) (Prims.of_int (4)) (Prims.of_int (413)) (Prims.of_int (16))))) (Obj.magic (FStar_Tactics_V1_Builtins.catch f)) (fun uu___ -> @@ -2333,13 +2333,13 @@ let trytac : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (417)) (Prims.of_int (13)) - (Prims.of_int (417)) (Prims.of_int (19))))) + (Prims.of_int (416)) (Prims.of_int (13)) + (Prims.of_int (416)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (417)) (Prims.of_int (8)) - (Prims.of_int (417)) (Prims.of_int (19))))) + (Prims.of_int (416)) (Prims.of_int (8)) + (Prims.of_int (416)) (Prims.of_int (19))))) (Obj.magic (t ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2384,12 +2384,12 @@ let rec repeat : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (434)) (Prims.of_int (10)) (Prims.of_int (434)) + (Prims.of_int (433)) (Prims.of_int (10)) (Prims.of_int (433)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (434)) (Prims.of_int (4)) (Prims.of_int (436)) + (Prims.of_int (433)) (Prims.of_int (4)) (Prims.of_int (435)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V1_Builtins.catch t)) (fun uu___ -> @@ -2407,14 +2407,14 @@ let rec repeat : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (436)) (Prims.of_int (20)) - (Prims.of_int (436)) (Prims.of_int (28))))) + (Prims.of_int (435)) (Prims.of_int (20)) + (Prims.of_int (435)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (436)) (Prims.of_int (15)) - (Prims.of_int (436)) (Prims.of_int (28))))) + (Prims.of_int (435)) (Prims.of_int (15)) + (Prims.of_int (435)) (Prims.of_int (28))))) (Obj.magic (repeat t)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2429,12 +2429,12 @@ let repeat1 : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (439)) (Prims.of_int (4)) (Prims.of_int (439)) + (Prims.of_int (438)) (Prims.of_int (4)) (Prims.of_int (438)) (Prims.of_int (8))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (439)) (Prims.of_int (4)) (Prims.of_int (439)) + (Prims.of_int (438)) (Prims.of_int (4)) (Prims.of_int (438)) (Prims.of_int (20))))) (Obj.magic (t ())) (fun uu___ -> (fun uu___ -> @@ -2443,13 +2443,13 @@ let repeat1 : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (439)) (Prims.of_int (12)) - (Prims.of_int (439)) (Prims.of_int (20))))) + (Prims.of_int (438)) (Prims.of_int (12)) + (Prims.of_int (438)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (439)) (Prims.of_int (4)) - (Prims.of_int (439)) (Prims.of_int (20))))) + (Prims.of_int (438)) (Prims.of_int (4)) + (Prims.of_int (438)) (Prims.of_int (20))))) (Obj.magic (repeat t)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2464,12 +2464,12 @@ let repeat' : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (442)) (Prims.of_int (12)) (Prims.of_int (442)) + (Prims.of_int (441)) (Prims.of_int (12)) (Prims.of_int (441)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (442)) (Prims.of_int (24)) (Prims.of_int (442)) + (Prims.of_int (441)) (Prims.of_int (24)) (Prims.of_int (441)) (Prims.of_int (26))))) (Obj.magic (repeat f)) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())) let (norm_term : @@ -2483,12 +2483,12 @@ let (norm_term : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (446)) (Prims.of_int (8)) (Prims.of_int (447)) + (Prims.of_int (445)) (Prims.of_int (8)) (Prims.of_int (446)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (449)) (Prims.of_int (4)) (Prims.of_int (449)) + (Prims.of_int (448)) (Prims.of_int (4)) (Prims.of_int (448)) (Prims.of_int (23))))) (Obj.magic (try_with (fun uu___ -> match () with | () -> cur_env ()) @@ -2504,25 +2504,25 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (456)) (Prims.of_int (16)) (Prims.of_int (456)) + (Prims.of_int (455)) (Prims.of_int (16)) (Prims.of_int (455)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (455)) (Prims.of_int (27)) (Prims.of_int (462)) + (Prims.of_int (454)) (Prims.of_int (27)) (Prims.of_int (461)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (456)) (Prims.of_int (16)) - (Prims.of_int (456)) (Prims.of_int (24))))) + (Prims.of_int (455)) (Prims.of_int (16)) + (Prims.of_int (455)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (456)) (Prims.of_int (16)) - (Prims.of_int (456)) (Prims.of_int (38))))) + (Prims.of_int (455)) (Prims.of_int (16)) + (Prims.of_int (455)) (Prims.of_int (38))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -2532,14 +2532,14 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (456)) (Prims.of_int (26)) - (Prims.of_int (456)) (Prims.of_int (38))))) + (Prims.of_int (455)) (Prims.of_int (26)) + (Prims.of_int (455)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (456)) (Prims.of_int (16)) - (Prims.of_int (456)) (Prims.of_int (38))))) + (Prims.of_int (455)) (Prims.of_int (16)) + (Prims.of_int (455)) (Prims.of_int (38))))) (Obj.magic (smt_goals ())) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -2554,14 +2554,14 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (457)) (Prims.of_int (2)) - (Prims.of_int (457)) (Prims.of_int (18))))) + (Prims.of_int (456)) (Prims.of_int (2)) + (Prims.of_int (456)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (458)) (Prims.of_int (2)) - (Prims.of_int (462)) (Prims.of_int (20))))) + (Prims.of_int (457)) (Prims.of_int (2)) + (Prims.of_int (461)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_smt_goals [])) (fun uu___2 -> (fun uu___2 -> @@ -2571,17 +2571,17 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (458)) + (Prims.of_int (457)) (Prims.of_int (2)) - (Prims.of_int (458)) + (Prims.of_int (457)) (Prims.of_int (15))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (459)) + (Prims.of_int (458)) (Prims.of_int (2)) - (Prims.of_int (462)) + (Prims.of_int (461)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_goals sgs)) @@ -2593,17 +2593,17 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (459)) + (Prims.of_int (458)) (Prims.of_int (2)) - (Prims.of_int (459)) + (Prims.of_int (458)) (Prims.of_int (14))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (459)) + (Prims.of_int (458)) (Prims.of_int (15)) - (Prims.of_int (462)) + (Prims.of_int (461)) (Prims.of_int (20))))) (Obj.magic (repeat' @@ -2616,17 +2616,17 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (460)) + (Prims.of_int (459)) (Prims.of_int (13)) - (Prims.of_int (460)) + (Prims.of_int (459)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (461)) + (Prims.of_int (460)) (Prims.of_int (2)) - (Prims.of_int (462)) + (Prims.of_int (461)) (Prims.of_int (20))))) (Obj.magic (goals ())) (fun uu___5 -> @@ -2638,18 +2638,18 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (461)) + (Prims.of_int (460)) (Prims.of_int (2)) - (Prims.of_int (461)) + (Prims.of_int (460)) (Prims.of_int (14))))) (FStar_Sealed.seal ( Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (462)) + (Prims.of_int (461)) (Prims.of_int (2)) - (Prims.of_int (462)) + (Prims.of_int (461)) (Prims.of_int (20))))) (Obj.magic ( @@ -2676,13 +2676,13 @@ let discard : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (465)) (Prims.of_int (22)) - (Prims.of_int (465)) (Prims.of_int (28))))) + (Prims.of_int (464)) (Prims.of_int (22)) + (Prims.of_int (464)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (465)) (Prims.of_int (32)) - (Prims.of_int (465)) (Prims.of_int (34))))) + (Prims.of_int (464)) (Prims.of_int (32)) + (Prims.of_int (464)) (Prims.of_int (34))))) (Obj.magic (tau ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let rec repeatseq : @@ -2695,12 +2695,12 @@ let rec repeatseq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (469)) (Prims.of_int (12)) (Prims.of_int (469)) + (Prims.of_int (468)) (Prims.of_int (12)) (Prims.of_int (468)) (Prims.of_int (82))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (469)) (Prims.of_int (86)) (Prims.of_int (469)) + (Prims.of_int (468)) (Prims.of_int (86)) (Prims.of_int (468)) (Prims.of_int (88))))) (Obj.magic (trytac @@ -2720,12 +2720,12 @@ let (admit_all : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (477)) (Prims.of_int (12)) (Prims.of_int (477)) + (Prims.of_int (476)) (Prims.of_int (12)) (Prims.of_int (476)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (478)) (Prims.of_int (4)) (Prims.of_int (478)) + (Prims.of_int (477)) (Prims.of_int (4)) (Prims.of_int (477)) (Prims.of_int (6))))) (Obj.magic (repeat tadmit)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let (is_guard : unit -> (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) = @@ -2734,12 +2734,12 @@ let (is_guard : unit -> (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (482)) (Prims.of_int (33)) (Prims.of_int (482)) + (Prims.of_int (481)) (Prims.of_int (33)) (Prims.of_int (481)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (482)) (Prims.of_int (4)) (Prims.of_int (482)) + (Prims.of_int (481)) (Prims.of_int (4)) (Prims.of_int (481)) (Prims.of_int (47))))) (Obj.magic (_cur_goal ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2750,12 +2750,12 @@ let (skip_guard : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (485)) (Prims.of_int (7)) (Prims.of_int (485)) + (Prims.of_int (484)) (Prims.of_int (7)) (Prims.of_int (484)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (485)) (Prims.of_int (4)) (Prims.of_int (487)) + (Prims.of_int (484)) (Prims.of_int (4)) (Prims.of_int (486)) (Prims.of_int (16))))) (Obj.magic (is_guard ())) (fun uu___1 -> (fun uu___1 -> @@ -2768,12 +2768,12 @@ let (guards_to_smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (490)) (Prims.of_int (12)) (Prims.of_int (490)) + (Prims.of_int (489)) (Prims.of_int (12)) (Prims.of_int (489)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (491)) (Prims.of_int (4)) (Prims.of_int (491)) + (Prims.of_int (490)) (Prims.of_int (4)) (Prims.of_int (490)) (Prims.of_int (6))))) (Obj.magic (repeat skip_guard)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let (simpl : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = @@ -2805,12 +2805,12 @@ let (intros' : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (499)) (Prims.of_int (36)) (Prims.of_int (499)) + (Prims.of_int (498)) (Prims.of_int (36)) (Prims.of_int (498)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (499)) (Prims.of_int (49)) (Prims.of_int (499)) + (Prims.of_int (498)) (Prims.of_int (49)) (Prims.of_int (498)) (Prims.of_int (51))))) (Obj.magic (intros ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let (destruct : @@ -2821,12 +2821,12 @@ let (destruct : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (500)) (Prims.of_int (37)) (Prims.of_int (500)) + (Prims.of_int (499)) (Prims.of_int (37)) (Prims.of_int (499)) (Prims.of_int (50))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (500)) (Prims.of_int (54)) (Prims.of_int (500)) + (Prims.of_int (499)) (Prims.of_int (54)) (Prims.of_int (499)) (Prims.of_int (56))))) (Obj.magic (FStar_Tactics_V1_Builtins.t_destruct tm)) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())) @@ -2840,13 +2840,13 @@ let (destruct_intros : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (501)) (Prims.of_int (59)) - (Prims.of_int (501)) (Prims.of_int (72))))) + (Prims.of_int (500)) (Prims.of_int (59)) + (Prims.of_int (500)) (Prims.of_int (72))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (501)) (Prims.of_int (76)) - (Prims.of_int (501)) (Prims.of_int (78))))) + (Prims.of_int (500)) (Prims.of_int (76)) + (Prims.of_int (500)) (Prims.of_int (78))))) (Obj.magic (FStar_Tactics_V1_Builtins.t_destruct tm)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ()))) intros' @@ -2860,12 +2860,12 @@ let (tcut : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (507)) (Prims.of_int (12)) (Prims.of_int (507)) + (Prims.of_int (506)) (Prims.of_int (12)) (Prims.of_int (506)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (507)) (Prims.of_int (26)) (Prims.of_int (510)) + (Prims.of_int (506)) (Prims.of_int (26)) (Prims.of_int (509)) (Prims.of_int (12))))) (Obj.magic (cur_goal ())) (fun uu___ -> (fun g -> @@ -2874,13 +2874,13 @@ let (tcut : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (508)) (Prims.of_int (13)) - (Prims.of_int (508)) (Prims.of_int (37))))) + (Prims.of_int (507)) (Prims.of_int (13)) + (Prims.of_int (507)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (509)) (Prims.of_int (4)) - (Prims.of_int (510)) (Prims.of_int (12))))) + (Prims.of_int (508)) (Prims.of_int (4)) + (Prims.of_int (509)) (Prims.of_int (12))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Reflection_V1_Derived.mk_e_app @@ -2900,14 +2900,14 @@ let (tcut : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (509)) (Prims.of_int (4)) - (Prims.of_int (509)) (Prims.of_int (12))))) + (Prims.of_int (508)) (Prims.of_int (4)) + (Prims.of_int (508)) (Prims.of_int (12))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (510)) (Prims.of_int (4)) - (Prims.of_int (510)) (Prims.of_int (12))))) + (Prims.of_int (509)) (Prims.of_int (4)) + (Prims.of_int (509)) (Prims.of_int (12))))) (Obj.magic (apply tt)) (fun uu___ -> (fun uu___ -> @@ -2923,12 +2923,12 @@ let (pose : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (513)) (Prims.of_int (4)) (Prims.of_int (513)) + (Prims.of_int (512)) (Prims.of_int (4)) (Prims.of_int (512)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (514)) (Prims.of_int (4)) (Prims.of_int (516)) + (Prims.of_int (513)) (Prims.of_int (4)) (Prims.of_int (515)) (Prims.of_int (12))))) (Obj.magic (apply @@ -2943,13 +2943,13 @@ let (pose : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (514)) (Prims.of_int (4)) - (Prims.of_int (514)) (Prims.of_int (11))))) + (Prims.of_int (513)) (Prims.of_int (4)) + (Prims.of_int (513)) (Prims.of_int (11))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (515)) (Prims.of_int (4)) - (Prims.of_int (516)) (Prims.of_int (12))))) + (Prims.of_int (514)) (Prims.of_int (4)) + (Prims.of_int (515)) (Prims.of_int (12))))) (Obj.magic (flip ())) (fun uu___1 -> (fun uu___1 -> @@ -2959,14 +2959,14 @@ let (pose : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (515)) (Prims.of_int (4)) - (Prims.of_int (515)) (Prims.of_int (11))))) + (Prims.of_int (514)) (Prims.of_int (4)) + (Prims.of_int (514)) (Prims.of_int (11))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (516)) (Prims.of_int (4)) - (Prims.of_int (516)) (Prims.of_int (12))))) + (Prims.of_int (515)) (Prims.of_int (4)) + (Prims.of_int (515)) (Prims.of_int (12))))) (Obj.magic (exact t)) (fun uu___2 -> (fun uu___2 -> @@ -2982,12 +2982,12 @@ let (intro_as : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (519)) (Prims.of_int (12)) (Prims.of_int (519)) + (Prims.of_int (518)) (Prims.of_int (12)) (Prims.of_int (518)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (520)) (Prims.of_int (4)) (Prims.of_int (520)) + (Prims.of_int (519)) (Prims.of_int (4)) (Prims.of_int (519)) (Prims.of_int (17))))) (Obj.magic (FStar_Tactics_V1_Builtins.intro ())) (fun uu___ -> @@ -3003,12 +3003,12 @@ let (pose_as : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (523)) (Prims.of_int (12)) - (Prims.of_int (523)) (Prims.of_int (18))))) + (Prims.of_int (522)) (Prims.of_int (12)) + (Prims.of_int (522)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (524)) (Prims.of_int (4)) (Prims.of_int (524)) + (Prims.of_int (523)) (Prims.of_int (4)) (Prims.of_int (523)) (Prims.of_int (17))))) (Obj.magic (pose t)) (fun uu___ -> (fun b -> Obj.magic (FStar_Tactics_V1_Builtins.rename_to b s)) @@ -3024,12 +3024,12 @@ let for_each_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (527)) (Prims.of_int (10)) (Prims.of_int (527)) + (Prims.of_int (526)) (Prims.of_int (10)) (Prims.of_int (526)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (527)) (Prims.of_int (4)) (Prims.of_int (527)) + (Prims.of_int (526)) (Prims.of_int (4)) (Prims.of_int (526)) (Prims.of_int (26))))) (Obj.magic (cur_binders ())) (fun uu___ -> (fun uu___ -> Obj.magic (FStar_Tactics_Util.map f uu___)) uu___) @@ -3050,13 +3050,13 @@ let rec (revert_all : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (532)) (Prims.of_int (15)) - (Prims.of_int (532)) (Prims.of_int (24))))) + (Prims.of_int (531)) (Prims.of_int (15)) + (Prims.of_int (531)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (533)) (Prims.of_int (15)) - (Prims.of_int (533)) (Prims.of_int (28))))) + (Prims.of_int (532)) (Prims.of_int (15)) + (Prims.of_int (532)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V1_Builtins.revert ())) (fun uu___1 -> (fun uu___1 -> Obj.magic (revert_all tl)) uu___1)))) @@ -3076,12 +3076,12 @@ let (binder_to_term : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (540)) (Prims.of_int (14)) (Prims.of_int (540)) + (Prims.of_int (539)) (Prims.of_int (14)) (Prims.of_int (539)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (541)) (Prims.of_int (2)) (Prims.of_int (541)) + (Prims.of_int (540)) (Prims.of_int (2)) (Prims.of_int (540)) (Prims.of_int (28))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Reflection_V1_Builtins.inspect_binder b)) @@ -3115,13 +3115,13 @@ let rec (__assumption_aux : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (553)) (Prims.of_int (16)) - (Prims.of_int (553)) (Prims.of_int (32))))) + (Prims.of_int (552)) (Prims.of_int (16)) + (Prims.of_int (552)) (Prims.of_int (32))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (554)) (Prims.of_int (8)) - (Prims.of_int (557)) (Prims.of_int (27))))) + (Prims.of_int (553)) (Prims.of_int (8)) + (Prims.of_int (556)) (Prims.of_int (27))))) (Obj.magic (binder_to_term b)) (fun uu___ -> (fun t -> @@ -3138,17 +3138,17 @@ let rec (__assumption_aux : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (555)) + (Prims.of_int (554)) (Prims.of_int (13)) - (Prims.of_int (555)) + (Prims.of_int (554)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (556)) + (Prims.of_int (555)) (Prims.of_int (13)) - (Prims.of_int (556)) + (Prims.of_int (555)) (Prims.of_int (20))))) (Obj.magic (apply @@ -3169,12 +3169,12 @@ let (assumption : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (560)) (Prims.of_int (21)) (Prims.of_int (560)) + (Prims.of_int (559)) (Prims.of_int (21)) (Prims.of_int (559)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (560)) (Prims.of_int (4)) (Prims.of_int (560)) + (Prims.of_int (559)) (Prims.of_int (4)) (Prims.of_int (559)) (Prims.of_int (37))))) (Obj.magic (cur_binders ())) (fun uu___1 -> (fun uu___1 -> Obj.magic (__assumption_aux uu___1)) uu___1) @@ -3189,12 +3189,12 @@ let (destruct_equality_implication : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (563)) (Prims.of_int (10)) (Prims.of_int (563)) + (Prims.of_int (562)) (Prims.of_int (10)) (Prims.of_int (562)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (563)) (Prims.of_int (4)) (Prims.of_int (570)) + (Prims.of_int (562)) (Prims.of_int (4)) (Prims.of_int (569)) (Prims.of_int (15))))) (Obj.magic (FStar_Reflection_V1_Formula.term_as_formula t)) (fun uu___ -> @@ -3208,14 +3208,14 @@ let (destruct_equality_implication : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (565)) (Prims.of_int (18)) - (Prims.of_int (565)) (Prims.of_int (38))))) + (Prims.of_int (564)) (Prims.of_int (18)) + (Prims.of_int (564)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (566)) (Prims.of_int (14)) - (Prims.of_int (568)) (Prims.of_int (19))))) + (Prims.of_int (565)) (Prims.of_int (14)) + (Prims.of_int (567)) (Prims.of_int (19))))) (Obj.magic (FStar_Reflection_V1_Formula.term_as_formula' lhs)) (fun lhs1 -> @@ -3244,13 +3244,13 @@ let (rewrite' : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (579)) (Prims.of_int (20)) - (Prims.of_int (579)) (Prims.of_int (35))))) + (Prims.of_int (578)) (Prims.of_int (20)) + (Prims.of_int (578)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (580)) (Prims.of_int (20)) - (Prims.of_int (581)) (Prims.of_int (29))))) + (Prims.of_int (579)) (Prims.of_int (20)) + (Prims.of_int (580)) (Prims.of_int (29))))) (Obj.magic (FStar_Tactics_V1_Builtins.binder_retype b)) (fun uu___1 -> (fun uu___1 -> @@ -3260,14 +3260,14 @@ let (rewrite' : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (580)) (Prims.of_int (20)) - (Prims.of_int (580)) (Prims.of_int (43))))) + (Prims.of_int (579)) (Prims.of_int (20)) + (Prims.of_int (579)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (581)) (Prims.of_int (20)) - (Prims.of_int (581)) (Prims.of_int (29))))) + (Prims.of_int (580)) (Prims.of_int (20)) + (Prims.of_int (580)) (Prims.of_int (29))))) (Obj.magic (apply_lemma (FStar_Reflection_V2_Builtins.pack_ln @@ -3307,14 +3307,14 @@ let rec (try_rewrite_equality : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (589)) (Prims.of_int (20)) - (Prims.of_int (589)) (Prims.of_int (56))))) + (Prims.of_int (588)) (Prims.of_int (20)) + (Prims.of_int (588)) (Prims.of_int (56))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (589)) (Prims.of_int (14)) - (Prims.of_int (595)) (Prims.of_int (37))))) + (Prims.of_int (588)) (Prims.of_int (14)) + (Prims.of_int (594)) (Prims.of_int (37))))) (Obj.magic (FStar_Reflection_V1_Formula.term_as_formula (FStar_Reflection_V1_Derived.type_of_binder x_t))) @@ -3350,13 +3350,13 @@ let rec (rewrite_all_context_equalities : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (602)) (Prims.of_int (8)) - (Prims.of_int (602)) (Prims.of_int (40))))) + (Prims.of_int (601)) (Prims.of_int (8)) + (Prims.of_int (601)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (603)) (Prims.of_int (8)) - (Prims.of_int (603)) (Prims.of_int (41))))) + (Prims.of_int (602)) (Prims.of_int (8)) + (Prims.of_int (602)) (Prims.of_int (41))))) (Obj.magic (try_with (fun uu___ -> @@ -3378,12 +3378,12 @@ let (rewrite_eqs_from_context : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (607)) (Prims.of_int (35)) (Prims.of_int (607)) + (Prims.of_int (606)) (Prims.of_int (35)) (Prims.of_int (606)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (607)) (Prims.of_int (4)) (Prims.of_int (607)) + (Prims.of_int (606)) (Prims.of_int (4)) (Prims.of_int (606)) (Prims.of_int (51))))) (Obj.magic (cur_binders ())) (fun uu___1 -> (fun uu___1 -> Obj.magic (rewrite_all_context_equalities uu___1)) @@ -3396,12 +3396,12 @@ let (rewrite_equality : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (610)) (Prims.of_int (27)) (Prims.of_int (610)) + (Prims.of_int (609)) (Prims.of_int (27)) (Prims.of_int (609)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (610)) (Prims.of_int (4)) (Prims.of_int (610)) + (Prims.of_int (609)) (Prims.of_int (4)) (Prims.of_int (609)) (Prims.of_int (43))))) (Obj.magic (cur_binders ())) (fun uu___ -> (fun uu___ -> Obj.magic (try_rewrite_equality t uu___)) uu___) @@ -3413,12 +3413,12 @@ let (unfold_def : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (613)) (Prims.of_int (10)) (Prims.of_int (613)) + (Prims.of_int (612)) (Prims.of_int (10)) (Prims.of_int (612)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (613)) (Prims.of_int (4)) (Prims.of_int (617)) + (Prims.of_int (612)) (Prims.of_int (4)) (Prims.of_int (616)) (Prims.of_int (46))))) (Obj.magic (FStar_Tactics_V1_Builtins.inspect t)) (fun uu___ -> @@ -3432,14 +3432,14 @@ let (unfold_def : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (615)) (Prims.of_int (16)) - (Prims.of_int (615)) (Prims.of_int (42))))) + (Prims.of_int (614)) (Prims.of_int (16)) + (Prims.of_int (614)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (616)) (Prims.of_int (8)) - (Prims.of_int (616)) (Prims.of_int (30))))) + (Prims.of_int (615)) (Prims.of_int (8)) + (Prims.of_int (615)) (Prims.of_int (30))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> FStar_Reflection_V1_Builtins.implode_qn @@ -3462,12 +3462,12 @@ let (l_to_r : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (624)) (Prims.of_int (8)) (Prims.of_int (627)) + (Prims.of_int (623)) (Prims.of_int (8)) (Prims.of_int (626)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (628)) (Prims.of_int (4)) (Prims.of_int (628)) + (Prims.of_int (627)) (Prims.of_int (4)) (Prims.of_int (627)) (Prims.of_int (28))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> @@ -3476,13 +3476,13 @@ let (l_to_r : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (624)) (Prims.of_int (8)) - (Prims.of_int (627)) (Prims.of_int (31))))) + (Prims.of_int (623)) (Prims.of_int (8)) + (Prims.of_int (626)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (624)) (Prims.of_int (8)) - (Prims.of_int (627)) (Prims.of_int (31))))) + (Prims.of_int (623)) (Prims.of_int (8)) + (Prims.of_int (626)) (Prims.of_int (31))))) (Obj.magic (FStar_Tactics_Util.fold_left (fun uu___3 -> @@ -3530,13 +3530,13 @@ let (grewrite : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (641)) (Prims.of_int (12)) - (Prims.of_int (641)) (Prims.of_int (33))))) + (Prims.of_int (640)) (Prims.of_int (12)) + (Prims.of_int (640)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (641)) (Prims.of_int (36)) - (Prims.of_int (655)) (Prims.of_int (44))))) + (Prims.of_int (640)) (Prims.of_int (36)) + (Prims.of_int (654)) (Prims.of_int (44))))) (Obj.magic (tcut (mk_sq_eq t1 t2))) (fun uu___ -> (fun e -> @@ -3545,13 +3545,13 @@ let (grewrite : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (642)) (Prims.of_int (12)) - (Prims.of_int (642)) (Prims.of_int (45))))) + (Prims.of_int (641)) (Prims.of_int (12)) + (Prims.of_int (641)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (643)) (Prims.of_int (4)) - (Prims.of_int (655)) (Prims.of_int (44))))) + (Prims.of_int (642)) (Prims.of_int (4)) + (Prims.of_int (654)) (Prims.of_int (44))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Reflection_V1_Builtins.pack_ln @@ -3567,17 +3567,17 @@ let (grewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (646)) + (Prims.of_int (645)) (Prims.of_int (8)) - (Prims.of_int (651)) + (Prims.of_int (650)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (653)) + (Prims.of_int (652)) (Prims.of_int (6)) - (Prims.of_int (655)) + (Prims.of_int (654)) (Prims.of_int (43))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3585,17 +3585,17 @@ let (grewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (646)) + (Prims.of_int (645)) (Prims.of_int (14)) - (Prims.of_int (646)) + (Prims.of_int (645)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (646)) + (Prims.of_int (645)) (Prims.of_int (8)) - (Prims.of_int (651)) + (Prims.of_int (650)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3603,17 +3603,17 @@ let (grewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (646)) + (Prims.of_int (645)) (Prims.of_int (30)) - (Prims.of_int (646)) + (Prims.of_int (645)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (646)) + (Prims.of_int (645)) (Prims.of_int (14)) - (Prims.of_int (646)) + (Prims.of_int (645)) (Prims.of_int (42))))) (Obj.magic (cur_goal ())) (fun uu___1 -> @@ -3657,12 +3657,12 @@ let (grewrite_eq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (662)) (Prims.of_int (8)) (Prims.of_int (662)) + (Prims.of_int (661)) (Prims.of_int (8)) (Prims.of_int (661)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (662)) (Prims.of_int (2)) (Prims.of_int (674)) + (Prims.of_int (661)) (Prims.of_int (2)) (Prims.of_int (673)) (Prims.of_int (7))))) (Obj.magic (FStar_Reflection_V1_Formula.term_as_formula @@ -3678,14 +3678,14 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (664)) (Prims.of_int (4)) - (Prims.of_int (664)) (Prims.of_int (16))))) + (Prims.of_int (663)) (Prims.of_int (4)) + (Prims.of_int (663)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (665)) (Prims.of_int (4)) - (Prims.of_int (665)) (Prims.of_int (54))))) + (Prims.of_int (664)) (Prims.of_int (4)) + (Prims.of_int (664)) (Prims.of_int (54))))) (Obj.magic (grewrite l r)) (fun uu___2 -> (fun uu___2 -> @@ -3698,17 +3698,17 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (665)) + (Prims.of_int (664)) (Prims.of_int (34)) - (Prims.of_int (665)) + (Prims.of_int (664)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (665)) + (Prims.of_int (664)) (Prims.of_int (28)) - (Prims.of_int (665)) + (Prims.of_int (664)) (Prims.of_int (52))))) (Obj.magic (binder_to_term b)) (fun uu___4 -> @@ -3722,14 +3722,14 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (667)) (Prims.of_int (16)) - (Prims.of_int (667)) (Prims.of_int (51))))) + (Prims.of_int (666)) (Prims.of_int (16)) + (Prims.of_int (666)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (667)) (Prims.of_int (10)) - (Prims.of_int (673)) (Prims.of_int (56))))) + (Prims.of_int (666)) (Prims.of_int (10)) + (Prims.of_int (672)) (Prims.of_int (56))))) (Obj.magic (FStar_Reflection_V1_Formula.term_as_formula' (FStar_Reflection_V1_Derived.type_of_binder b))) @@ -3746,17 +3746,17 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (669)) + (Prims.of_int (668)) (Prims.of_int (6)) - (Prims.of_int (669)) + (Prims.of_int (668)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (670)) + (Prims.of_int (669)) (Prims.of_int (6)) - (Prims.of_int (671)) + (Prims.of_int (670)) (Prims.of_int (56))))) (Obj.magic (grewrite l r)) (fun uu___4 -> @@ -3770,17 +3770,17 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (670)) + (Prims.of_int (669)) (Prims.of_int (30)) - (Prims.of_int (670)) + (Prims.of_int (669)) (Prims.of_int (55))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (671)) + (Prims.of_int (670)) (Prims.of_int (30)) - (Prims.of_int (671)) + (Prims.of_int (670)) (Prims.of_int (54))))) (Obj.magic (apply_lemma @@ -3800,17 +3800,17 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (671)) + (Prims.of_int (670)) (Prims.of_int (36)) - (Prims.of_int (671)) + (Prims.of_int (670)) (Prims.of_int (54))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (671)) + (Prims.of_int (670)) (Prims.of_int (30)) - (Prims.of_int (671)) + (Prims.of_int (670)) (Prims.of_int (54))))) (Obj.magic (binder_to_term @@ -3848,14 +3848,14 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (696)) (Prims.of_int (8)) - (Prims.of_int (696)) (Prims.of_int (43))))) + (Prims.of_int (695)) (Prims.of_int (8)) + (Prims.of_int (695)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (696)) (Prims.of_int (45)) - (Prims.of_int (696)) (Prims.of_int (52))))) + (Prims.of_int (695)) (Prims.of_int (45)) + (Prims.of_int (695)) (Prims.of_int (52))))) (Obj.magic (apply (FStar_Reflection_V2_Builtins.pack_ln @@ -3879,17 +3879,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (13)) - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (33)) - (Prims.of_int (751)) + (Prims.of_int (750)) (Prims.of_int (41))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3897,17 +3897,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (16)) - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (13)) - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (30))))) (Obj.magic (cur_env ())) (fun uu___4 -> @@ -3923,17 +3923,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (703)) + (Prims.of_int (702)) (Prims.of_int (17)) - (Prims.of_int (703)) + (Prims.of_int (702)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (33)) - (Prims.of_int (751)) + (Prims.of_int (750)) (Prims.of_int (41))))) (Obj.magic (FStar_Tactics_V1_SyntaxHelpers.collect_arr @@ -3957,18 +3957,18 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (707)) + (Prims.of_int (706)) (Prims.of_int (18)) - (Prims.of_int (707)) + (Prims.of_int (706)) (Prims.of_int (32))))) ( FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (707)) + (Prims.of_int (706)) (Prims.of_int (35)) - (Prims.of_int (716)) + (Prims.of_int (715)) (Prims.of_int (41))))) ( FStar_Tactics_Effect.lift_div_tac @@ -3992,17 +3992,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (708)) + (Prims.of_int (707)) (Prims.of_int (18)) - (Prims.of_int (708)) + (Prims.of_int (707)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (710)) + (Prims.of_int (709)) (Prims.of_int (7)) - (Prims.of_int (716)) + (Prims.of_int (715)) (Prims.of_int (41))))) (Obj.magic (norm_term @@ -4017,17 +4017,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (710)) + (Prims.of_int (709)) (Prims.of_int (13)) - (Prims.of_int (710)) + (Prims.of_int (709)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (710)) + (Prims.of_int (709)) (Prims.of_int (7)) - (Prims.of_int (716)) + (Prims.of_int (715)) (Prims.of_int (41))))) (Obj.magic (FStar_Reflection_V1_Formula.term_as_formula' @@ -4048,17 +4048,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (712)) + (Prims.of_int (711)) (Prims.of_int (11)) - (Prims.of_int (712)) + (Prims.of_int (711)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (713)) + (Prims.of_int (712)) (Prims.of_int (11)) - (Prims.of_int (713)) + (Prims.of_int (712)) (Prims.of_int (38))))) (Obj.magic (apply_lemma @@ -4104,17 +4104,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (724)) + (Prims.of_int (723)) (Prims.of_int (18)) - (Prims.of_int (724)) + (Prims.of_int (723)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (726)) + (Prims.of_int (725)) (Prims.of_int (9)) - (Prims.of_int (732)) + (Prims.of_int (731)) (Prims.of_int (43))))) (Obj.magic (norm_term @@ -4129,17 +4129,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (726)) + (Prims.of_int (725)) (Prims.of_int (15)) - (Prims.of_int (726)) + (Prims.of_int (725)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (726)) + (Prims.of_int (725)) (Prims.of_int (9)) - (Prims.of_int (732)) + (Prims.of_int (731)) (Prims.of_int (43))))) (Obj.magic (FStar_Reflection_V1_Formula.term_as_formula' @@ -4160,17 +4160,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (728)) + (Prims.of_int (727)) (Prims.of_int (13)) - (Prims.of_int (728)) + (Prims.of_int (727)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (729)) + (Prims.of_int (728)) (Prims.of_int (13)) - (Prims.of_int (729)) + (Prims.of_int (728)) (Prims.of_int (40))))) (Obj.magic (apply_lemma @@ -4207,17 +4207,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (739)) + (Prims.of_int (738)) (Prims.of_int (18)) - (Prims.of_int (739)) + (Prims.of_int (738)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (741)) + (Prims.of_int (740)) (Prims.of_int (9)) - (Prims.of_int (748)) + (Prims.of_int (747)) (Prims.of_int (20))))) (Obj.magic (norm_term @@ -4232,17 +4232,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (741)) + (Prims.of_int (740)) (Prims.of_int (15)) - (Prims.of_int (741)) + (Prims.of_int (740)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (741)) + (Prims.of_int (740)) (Prims.of_int (9)) - (Prims.of_int (748)) + (Prims.of_int (747)) (Prims.of_int (20))))) (Obj.magic (FStar_Reflection_V1_Formula.term_as_formula' @@ -4262,17 +4262,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (743)) + (Prims.of_int (742)) (Prims.of_int (13)) - (Prims.of_int (743)) + (Prims.of_int (742)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (744)) + (Prims.of_int (743)) (Prims.of_int (13)) - (Prims.of_int (744)) + (Prims.of_int (743)) (Prims.of_int (40))))) (Obj.magic (apply_lemma @@ -4302,17 +4302,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (747)) + (Prims.of_int (746)) (Prims.of_int (13)) - (Prims.of_int (747)) + (Prims.of_int (746)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (748)) + (Prims.of_int (747)) (Prims.of_int (13)) - (Prims.of_int (748)) + (Prims.of_int (747)) (Prims.of_int (20))))) (Obj.magic (apply @@ -4346,12 +4346,12 @@ let (admit_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (761)) (Prims.of_int (2)) (Prims.of_int (761)) + (Prims.of_int (760)) (Prims.of_int (2)) (Prims.of_int (760)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (762)) (Prims.of_int (2)) (Prims.of_int (762)) + (Prims.of_int (761)) (Prims.of_int (2)) (Prims.of_int (761)) (Prims.of_int (16))))) (Obj.magic (FStar_Tactics_V1_Builtins.dump "Admitting")) (fun uu___1 -> @@ -4369,12 +4369,12 @@ let (magic_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (769)) (Prims.of_int (2)) (Prims.of_int (769)) + (Prims.of_int (768)) (Prims.of_int (2)) (Prims.of_int (768)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (770)) (Prims.of_int (2)) (Prims.of_int (772)) + (Prims.of_int (769)) (Prims.of_int (2)) (Prims.of_int (771)) (Prims.of_int (4))))) (Obj.magic (FStar_Tactics_V1_Builtins.dump "Admitting")) (fun uu___1 -> @@ -4384,13 +4384,13 @@ let (magic_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (770)) (Prims.of_int (2)) - (Prims.of_int (770)) (Prims.of_int (16))))) + (Prims.of_int (769)) (Prims.of_int (2)) + (Prims.of_int (769)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (771)) (Prims.of_int (2)) - (Prims.of_int (772)) (Prims.of_int (4))))) + (Prims.of_int (770)) (Prims.of_int (2)) + (Prims.of_int (771)) (Prims.of_int (4))))) (Obj.magic (apply (FStar_Reflection_V2_Builtins.pack_ln @@ -4405,14 +4405,14 @@ let (magic_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (771)) (Prims.of_int (2)) - (Prims.of_int (771)) (Prims.of_int (13))))) + (Prims.of_int (770)) (Prims.of_int (2)) + (Prims.of_int (770)) (Prims.of_int (13))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (772)) (Prims.of_int (2)) - (Prims.of_int (772)) (Prims.of_int (4))))) + (Prims.of_int (771)) (Prims.of_int (2)) + (Prims.of_int (771)) (Prims.of_int (4))))) (Obj.magic (exact (FStar_Reflection_V2_Builtins.pack_ln @@ -4434,13 +4434,13 @@ let (change_with : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (779)) (Prims.of_int (8)) - (Prims.of_int (779)) (Prims.of_int (22))))) + (Prims.of_int (778)) (Prims.of_int (8)) + (Prims.of_int (778)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (780)) (Prims.of_int (8)) - (Prims.of_int (780)) (Prims.of_int (29))))) + (Prims.of_int (779)) (Prims.of_int (8)) + (Prims.of_int (779)) (Prims.of_int (29))))) (Obj.magic (grewrite t1 t2)) (fun uu___1 -> (fun uu___1 -> Obj.magic (iseq [idtac; trivial])) uu___1)) @@ -4464,12 +4464,12 @@ let finish_by : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (787)) (Prims.of_int (12)) (Prims.of_int (787)) + (Prims.of_int (786)) (Prims.of_int (12)) (Prims.of_int (786)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (788)) (Prims.of_int (4)) (Prims.of_int (789)) + (Prims.of_int (787)) (Prims.of_int (4)) (Prims.of_int (788)) (Prims.of_int (5))))) (Obj.magic (t ())) (fun uu___ -> (fun x -> @@ -4478,13 +4478,13 @@ let finish_by : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (788)) (Prims.of_int (4)) - (Prims.of_int (788)) (Prims.of_int (58))))) + (Prims.of_int (787)) (Prims.of_int (4)) + (Prims.of_int (787)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (787)) (Prims.of_int (8)) - (Prims.of_int (787)) (Prims.of_int (9))))) + (Prims.of_int (786)) (Prims.of_int (8)) + (Prims.of_int (786)) (Prims.of_int (9))))) (Obj.magic (or_else qed (fun uu___ -> @@ -4506,13 +4506,13 @@ let solve_then : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (792)) (Prims.of_int (4)) (Prims.of_int (792)) + (Prims.of_int (791)) (Prims.of_int (4)) (Prims.of_int (791)) (Prims.of_int (10))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (792)) (Prims.of_int (11)) - (Prims.of_int (796)) (Prims.of_int (5))))) + (Prims.of_int (791)) (Prims.of_int (11)) + (Prims.of_int (795)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V1_Builtins.dup ())) (fun uu___ -> (fun uu___ -> @@ -4521,13 +4521,13 @@ let solve_then : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (793)) (Prims.of_int (12)) - (Prims.of_int (793)) (Prims.of_int (42))))) + (Prims.of_int (792)) (Prims.of_int (12)) + (Prims.of_int (792)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (793)) (Prims.of_int (45)) - (Prims.of_int (796)) (Prims.of_int (5))))) + (Prims.of_int (792)) (Prims.of_int (45)) + (Prims.of_int (795)) (Prims.of_int (5))))) (Obj.magic (focus (fun uu___1 -> finish_by t1))) (fun uu___1 -> (fun x -> @@ -4537,17 +4537,17 @@ let solve_then : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (794)) + (Prims.of_int (793)) (Prims.of_int (12)) - (Prims.of_int (794)) + (Prims.of_int (793)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (795)) + (Prims.of_int (794)) (Prims.of_int (4)) - (Prims.of_int (796)) + (Prims.of_int (795)) (Prims.of_int (5))))) (Obj.magic (t2 x)) (fun uu___1 -> @@ -4558,17 +4558,17 @@ let solve_then : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (795)) + (Prims.of_int (794)) (Prims.of_int (4)) - (Prims.of_int (795)) + (Prims.of_int (794)) (Prims.of_int (12))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (794)) + (Prims.of_int (793)) (Prims.of_int (8)) - (Prims.of_int (794)) + (Prims.of_int (793)) (Prims.of_int (9))))) (Obj.magic (trefl ())) (fun uu___1 -> @@ -4587,13 +4587,13 @@ let add_elem : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (799)) (Prims.of_int (4)) - (Prims.of_int (799)) (Prims.of_int (17))))) + (Prims.of_int (798)) (Prims.of_int (4)) + (Prims.of_int (798)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (800)) (Prims.of_int (4)) - (Prims.of_int (804)) (Prims.of_int (5))))) + (Prims.of_int (799)) (Prims.of_int (4)) + (Prims.of_int (803)) (Prims.of_int (5))))) (Obj.magic (apply (FStar_Reflection_V2_Builtins.pack_ln @@ -4610,14 +4610,14 @@ let add_elem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (801)) (Prims.of_int (14)) - (Prims.of_int (801)) (Prims.of_int (18))))) + (Prims.of_int (800)) (Prims.of_int (14)) + (Prims.of_int (800)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (802)) (Prims.of_int (6)) - (Prims.of_int (803)) (Prims.of_int (7))))) + (Prims.of_int (801)) (Prims.of_int (6)) + (Prims.of_int (802)) (Prims.of_int (7))))) (Obj.magic (t ())) (fun uu___3 -> (fun x -> @@ -4627,17 +4627,17 @@ let add_elem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (802)) + (Prims.of_int (801)) (Prims.of_int (6)) - (Prims.of_int (802)) + (Prims.of_int (801)) (Prims.of_int (12))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (801)) + (Prims.of_int (800)) (Prims.of_int (10)) - (Prims.of_int (801)) + (Prims.of_int (800)) (Prims.of_int (11))))) (Obj.magic (qed ())) (fun uu___3 -> @@ -4659,13 +4659,13 @@ let specialize : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (823)) (Prims.of_int (42)) - (Prims.of_int (823)) (Prims.of_int (51))))) + (Prims.of_int (822)) (Prims.of_int (42)) + (Prims.of_int (822)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (823)) (Prims.of_int (36)) - (Prims.of_int (823)) (Prims.of_int (51))))) + (Prims.of_int (822)) (Prims.of_int (36)) + (Prims.of_int (822)) (Prims.of_int (51))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> (fun uu___2 -> @@ -4685,12 +4685,12 @@ let (tlabel : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (826)) (Prims.of_int (10)) (Prims.of_int (826)) + (Prims.of_int (825)) (Prims.of_int (10)) (Prims.of_int (825)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (826)) (Prims.of_int (4)) (Prims.of_int (829)) + (Prims.of_int (825)) (Prims.of_int (4)) (Prims.of_int (828)) (Prims.of_int (38))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -4707,12 +4707,12 @@ let (tlabel' : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (832)) (Prims.of_int (10)) (Prims.of_int (832)) + (Prims.of_int (831)) (Prims.of_int (10)) (Prims.of_int (831)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (832)) (Prims.of_int (4)) (Prims.of_int (836)) + (Prims.of_int (831)) (Prims.of_int (4)) (Prims.of_int (835)) (Prims.of_int (26))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -4726,14 +4726,14 @@ let (tlabel' : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (835)) (Prims.of_int (16)) - (Prims.of_int (835)) (Prims.of_int (45))))) + (Prims.of_int (834)) (Prims.of_int (16)) + (Prims.of_int (834)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (836)) (Prims.of_int (8)) - (Prims.of_int (836)) (Prims.of_int (26))))) + (Prims.of_int (835)) (Prims.of_int (8)) + (Prims.of_int (835)) (Prims.of_int (26))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> FStar_Tactics_Types.set_label @@ -4750,37 +4750,37 @@ let (focus_all : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (839)) (Prims.of_int (4)) (Prims.of_int (839)) + (Prims.of_int (838)) (Prims.of_int (4)) (Prims.of_int (838)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (840)) (Prims.of_int (4)) (Prims.of_int (840)) + (Prims.of_int (839)) (Prims.of_int (4)) (Prims.of_int (839)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (839)) (Prims.of_int (14)) - (Prims.of_int (839)) (Prims.of_int (39))))) + (Prims.of_int (838)) (Prims.of_int (14)) + (Prims.of_int (838)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (839)) (Prims.of_int (4)) - (Prims.of_int (839)) (Prims.of_int (39))))) + (Prims.of_int (838)) (Prims.of_int (4)) + (Prims.of_int (838)) (Prims.of_int (39))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (839)) (Prims.of_int (15)) - (Prims.of_int (839)) (Prims.of_int (23))))) + (Prims.of_int (838)) (Prims.of_int (15)) + (Prims.of_int (838)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (839)) (Prims.of_int (14)) - (Prims.of_int (839)) (Prims.of_int (39))))) + (Prims.of_int (838)) (Prims.of_int (14)) + (Prims.of_int (838)) (Prims.of_int (39))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -4790,17 +4790,17 @@ let (focus_all : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (839)) + (Prims.of_int (838)) (Prims.of_int (26)) - (Prims.of_int (839)) + (Prims.of_int (838)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (839)) + (Prims.of_int (838)) (Prims.of_int (14)) - (Prims.of_int (839)) + (Prims.of_int (838)) (Prims.of_int (39))))) (Obj.magic (smt_goals ())) (fun uu___2 -> @@ -4836,25 +4836,25 @@ let (bump_nth : Prims.pos -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (855)) (Prims.of_int (8)) (Prims.of_int (855)) + (Prims.of_int (854)) (Prims.of_int (8)) (Prims.of_int (854)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (855)) (Prims.of_int (2)) (Prims.of_int (857)) + (Prims.of_int (854)) (Prims.of_int (2)) (Prims.of_int (856)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (855)) (Prims.of_int (28)) - (Prims.of_int (855)) (Prims.of_int (38))))) + (Prims.of_int (854)) (Prims.of_int (28)) + (Prims.of_int (854)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (855)) (Prims.of_int (8)) - (Prims.of_int (855)) (Prims.of_int (38))))) + (Prims.of_int (854)) (Prims.of_int (8)) + (Prims.of_int (854)) (Prims.of_int (38))))) (Obj.magic (goals ())) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac @@ -4878,12 +4878,12 @@ let rec (destruct_list : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (860)) (Prims.of_int (21)) (Prims.of_int (860)) + (Prims.of_int (859)) (Prims.of_int (21)) (Prims.of_int (859)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (859)) (Prims.of_int (52)) (Prims.of_int (872)) + (Prims.of_int (858)) (Prims.of_int (52)) (Prims.of_int (871)) (Prims.of_int (27))))) (Obj.magic (FStar_Tactics_V1_SyntaxHelpers.collect_app t)) (fun uu___ -> @@ -4908,17 +4908,17 @@ let rec (destruct_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (865)) + (Prims.of_int (864)) (Prims.of_int (17)) - (Prims.of_int (865)) + (Prims.of_int (864)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (865)) + (Prims.of_int (864)) (Prims.of_int (11)) - (Prims.of_int (865)) + (Prims.of_int (864)) (Prims.of_int (33))))) (Obj.magic (destruct_list a2)) (fun uu___1 -> @@ -4944,17 +4944,17 @@ let rec (destruct_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (865)) + (Prims.of_int (864)) (Prims.of_int (17)) - (Prims.of_int (865)) + (Prims.of_int (864)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (865)) + (Prims.of_int (864)) (Prims.of_int (11)) - (Prims.of_int (865)) + (Prims.of_int (864)) (Prims.of_int (33))))) (Obj.magic (destruct_list a2)) (fun uu___2 -> @@ -4989,25 +4989,25 @@ let (get_match_body : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (875)) (Prims.of_int (8)) (Prims.of_int (875)) + (Prims.of_int (874)) (Prims.of_int (8)) (Prims.of_int (874)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (875)) (Prims.of_int (2)) (Prims.of_int (879)) + (Prims.of_int (874)) (Prims.of_int (2)) (Prims.of_int (878)) (Prims.of_int (46))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (875)) (Prims.of_int (22)) - (Prims.of_int (875)) (Prims.of_int (35))))) + (Prims.of_int (874)) (Prims.of_int (22)) + (Prims.of_int (874)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (875)) (Prims.of_int (8)) - (Prims.of_int (875)) (Prims.of_int (35))))) + (Prims.of_int (874)) (Prims.of_int (8)) + (Prims.of_int (874)) (Prims.of_int (35))))) (Obj.magic (cur_goal ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -5025,14 +5025,14 @@ let (get_match_body : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (877)) (Prims.of_int (20)) - (Prims.of_int (877)) (Prims.of_int (39))))) + (Prims.of_int (876)) (Prims.of_int (20)) + (Prims.of_int (876)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (877)) (Prims.of_int (14)) - (Prims.of_int (879)) (Prims.of_int (46))))) + (Prims.of_int (876)) (Prims.of_int (14)) + (Prims.of_int (878)) (Prims.of_int (46))))) (Obj.magic (FStar_Tactics_V1_SyntaxHelpers.inspect_unascribe t)) @@ -5061,13 +5061,13 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (892)) (Prims.of_int (14)) - (Prims.of_int (892)) (Prims.of_int (31))))) + (Prims.of_int (891)) (Prims.of_int (14)) + (Prims.of_int (891)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (892)) (Prims.of_int (34)) - (Prims.of_int (898)) (Prims.of_int (20))))) + (Prims.of_int (891)) (Prims.of_int (34)) + (Prims.of_int (897)) (Prims.of_int (20))))) (Obj.magic (get_match_body ())) (fun uu___2 -> (fun x -> @@ -5077,14 +5077,14 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (893)) (Prims.of_int (14)) - (Prims.of_int (893)) (Prims.of_int (26))))) + (Prims.of_int (892)) (Prims.of_int (14)) + (Prims.of_int (892)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (894)) (Prims.of_int (6)) - (Prims.of_int (898)) (Prims.of_int (20))))) + (Prims.of_int (893)) (Prims.of_int (6)) + (Prims.of_int (897)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V1_Builtins.t_destruct x)) (fun uu___2 -> (fun uu___2 -> @@ -5096,17 +5096,17 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (895)) + (Prims.of_int (894)) (Prims.of_int (17)) - (Prims.of_int (895)) + (Prims.of_int (894)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (895)) + (Prims.of_int (894)) (Prims.of_int (32)) - (Prims.of_int (898)) + (Prims.of_int (897)) (Prims.of_int (19))))) (Obj.magic (repeat @@ -5119,17 +5119,17 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (896)) + (Prims.of_int (895)) (Prims.of_int (16)) - (Prims.of_int (896)) + (Prims.of_int (895)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (897)) + (Prims.of_int (896)) (Prims.of_int (8)) - (Prims.of_int (898)) + (Prims.of_int (897)) (Prims.of_int (19))))) (Obj.magic (last bs)) (fun uu___4 -> @@ -5140,17 +5140,17 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (897)) + (Prims.of_int (896)) (Prims.of_int (8)) - (Prims.of_int (897)) + (Prims.of_int (896)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (898)) + (Prims.of_int (897)) (Prims.of_int (8)) - (Prims.of_int (898)) + (Prims.of_int (897)) (Prims.of_int (19))))) (Obj.magic (grewrite_eq b)) @@ -5172,12 +5172,12 @@ let (nth_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (907)) (Prims.of_int (11)) (Prims.of_int (907)) + (Prims.of_int (906)) (Prims.of_int (11)) (Prims.of_int (906)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (907)) (Prims.of_int (28)) (Prims.of_int (912)) + (Prims.of_int (906)) (Prims.of_int (28)) (Prims.of_int (911)) (Prims.of_int (15))))) (Obj.magic (cur_binders ())) (fun uu___ -> (fun bs -> @@ -5186,13 +5186,13 @@ let (nth_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (908)) (Prims.of_int (16)) - (Prims.of_int (908)) (Prims.of_int (65))))) + (Prims.of_int (907)) (Prims.of_int (16)) + (Prims.of_int (907)) (Prims.of_int (65))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (908)) (Prims.of_int (68)) - (Prims.of_int (912)) (Prims.of_int (15))))) + (Prims.of_int (907)) (Prims.of_int (68)) + (Prims.of_int (911)) (Prims.of_int (15))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> if i >= Prims.int_zero @@ -5206,14 +5206,14 @@ let (nth_binder : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (909)) (Prims.of_int (16)) - (Prims.of_int (909)) (Prims.of_int (62))))) + (Prims.of_int (908)) (Prims.of_int (16)) + (Prims.of_int (908)) (Prims.of_int (62))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (910)) (Prims.of_int (2)) - (Prims.of_int (912)) (Prims.of_int (15))))) + (Prims.of_int (909)) (Prims.of_int (2)) + (Prims.of_int (911)) (Prims.of_int (15))))) (if k < Prims.int_zero then fail "not enough binders" else @@ -5240,12 +5240,12 @@ let (name_appears_in : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (920)) (Prims.of_int (4)) (Prims.of_int (925)) + (Prims.of_int (919)) (Prims.of_int (4)) (Prims.of_int (924)) (Prims.of_int (12))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (927)) (Prims.of_int (2)) (Prims.of_int (929)) + (Prims.of_int (926)) (Prims.of_int (2)) (Prims.of_int (928)) (Prims.of_int (16))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> @@ -5261,17 +5261,17 @@ let (name_appears_in : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (922)) + (Prims.of_int (921)) (Prims.of_int (6)) - (Prims.of_int (923)) + (Prims.of_int (922)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (919)) + (Prims.of_int (918)) (Prims.of_int (10)) - (Prims.of_int (919)) + (Prims.of_int (918)) (Prims.of_int (11))))) (if (FStar_Reflection_V1_Builtins.inspect_fv @@ -5301,31 +5301,31 @@ let (name_appears_in : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (927)) (Prims.of_int (6)) - (Prims.of_int (927)) (Prims.of_int (30))))) + (Prims.of_int (926)) (Prims.of_int (6)) + (Prims.of_int (926)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (927)) (Prims.of_int (32)) - (Prims.of_int (927)) (Prims.of_int (37))))) + (Prims.of_int (926)) (Prims.of_int (32)) + (Prims.of_int (926)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (927)) + (Prims.of_int (926)) (Prims.of_int (13)) - (Prims.of_int (927)) + (Prims.of_int (926)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (927)) + (Prims.of_int (926)) (Prims.of_int (6)) - (Prims.of_int (927)) + (Prims.of_int (926)) (Prims.of_int (30))))) (Obj.magic (FStar_Tactics_Visit.visit_tm ff t)) @@ -5366,14 +5366,14 @@ let rec (mk_abs : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (936)) (Prims.of_int (13)) - (Prims.of_int (936)) (Prims.of_int (27))))) + (Prims.of_int (935)) (Prims.of_int (13)) + (Prims.of_int (935)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (937)) (Prims.of_int (4)) - (Prims.of_int (937)) (Prims.of_int (22))))) + (Prims.of_int (936)) (Prims.of_int (4)) + (Prims.of_int (936)) (Prims.of_int (22))))) (Obj.magic (mk_abs args' t)) (fun uu___ -> (fun t' -> @@ -5394,13 +5394,13 @@ let (string_to_term_with_lb : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (945)) (Prims.of_int (14)) - (Prims.of_int (945)) (Prims.of_int (32))))) + (Prims.of_int (944)) (Prims.of_int (14)) + (Prims.of_int (944)) (Prims.of_int (32))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (945)) (Prims.of_int (35)) - (Prims.of_int (951)) (Prims.of_int (75))))) + (Prims.of_int (944)) (Prims.of_int (35)) + (Prims.of_int (950)) (Prims.of_int (75))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Reflection_V2_Builtins.pack_ln @@ -5413,14 +5413,14 @@ let (string_to_term_with_lb : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (946)) (Prims.of_int (20)) - (Prims.of_int (949)) (Prims.of_int (27))))) + (Prims.of_int (945)) (Prims.of_int (20)) + (Prims.of_int (948)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (945)) (Prims.of_int (35)) - (Prims.of_int (951)) (Prims.of_int (75))))) + (Prims.of_int (944)) (Prims.of_int (35)) + (Prims.of_int (950)) (Prims.of_int (75))))) (Obj.magic (FStar_Tactics_Util.fold_left (fun uu___ -> @@ -5432,17 +5432,17 @@ let (string_to_term_with_lb : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (947)) + (Prims.of_int (946)) (Prims.of_int (20)) - (Prims.of_int (947)) + (Prims.of_int (946)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (946)) + (Prims.of_int (945)) (Prims.of_int (56)) - (Prims.of_int (948)) + (Prims.of_int (947)) (Prims.of_int (25))))) (Obj.magic (FStar_Tactics_V1_Builtins.push_bv_dsenv @@ -5464,17 +5464,17 @@ let (string_to_term_with_lb : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (950)) + (Prims.of_int (949)) (Prims.of_int (12)) - (Prims.of_int (950)) + (Prims.of_int (949)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (951)) + (Prims.of_int (950)) (Prims.of_int (4)) - (Prims.of_int (951)) + (Prims.of_int (950)) (Prims.of_int (75))))) (Obj.magic (FStar_Tactics_V1_Builtins.string_to_term diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml index a40fec710a7..6f87446b2cd 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml @@ -1,4 +1,12 @@ open Prims +let (dbg_TacUnify : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "TacUnify" +let (dbg_2635 : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "2635" +let (dbg_ReflTc : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ReflTc" +let (dbg_TacVerbose : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "TacVerbose" let (compress : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term FStar_Tactics_Monad.tac) @@ -37,7 +45,7 @@ let (core_check : then FStar_Pervasives.Inl FStar_Pervasives_Native.None else (let debug f = - let uu___2 = FStar_Options.debug_any () in + let uu___2 = FStar_Compiler_Debug.any () in if uu___2 then f () else () in let uu___2 = FStar_TypeChecker_Core.check_term env sol t must_tot in @@ -128,6 +136,8 @@ let (print : Prims.string -> unit FStar_Tactics_Monad.tac) = let uu___2 = FStar_Options.silent () in Prims.op_Negation uu___2 in if uu___1 then tacprint msg else ()); FStar_Class_Monad.return FStar_Tactics_Monad.monad_tac () (Obj.repr ()) +let (dbg_Tac : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Tac" let (debugging : unit -> Prims.bool FStar_Tactics_Monad.tac) = fun uu___ -> (fun uu___ -> @@ -137,10 +147,7 @@ let (debugging : unit -> Prims.bool FStar_Tactics_Monad.tac) = (fun uu___1 -> (fun ps -> let ps = Obj.magic ps in - let uu___1 = - FStar_TypeChecker_Env.debug - ps.FStar_Tactics_Types.main_context - (FStar_Options.Other "Tac") in + let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Tac in Obj.magic (FStar_Class_Monad.return FStar_Tactics_Monad.monad_tac () (Obj.magic uu___1))) uu___1))) uu___ @@ -1238,9 +1245,6 @@ let (__do_unify : fun env1 -> fun t1 -> fun t2 -> - let dbg = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "TacUnify") in let uu___ = FStar_Class_Monad.return FStar_Tactics_Monad.monad_tac () (Obj.repr ()) in @@ -1250,17 +1254,24 @@ let (__do_unify : (fun uu___1 -> (fun uu___1 -> let uu___1 = Obj.magic uu___1 in - if dbg - then - (FStar_Options.push (); - (let uu___4 = - FStar_Options.set_options - "--debug_level Rel --debug_level RelCheck" in - ())) - else (); (let uu___3 = - __do_unify_wflags dbg allow_guards - must_tot check_side env1 t1 t2 in + FStar_Compiler_Effect.op_Bang + dbg_TacUnify in + if uu___3 + then + (FStar_Options.push (); + (let uu___5 = + FStar_Options.set_options + "--debug Rel,RelCheck" in + ())) + else ()); + (let uu___3 = + let uu___4 = + FStar_Compiler_Effect.op_Bang + dbg_TacUnify in + __do_unify_wflags uu___4 + allow_guards must_tot check_side + env1 t1 t2 in Obj.magic (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () @@ -1268,9 +1279,12 @@ let (__do_unify : (fun uu___4 -> (fun r -> let r = Obj.magic r in - if dbg - then FStar_Options.pop () - else (); + (let uu___5 = + FStar_Compiler_Effect.op_Bang + dbg_TacUnify in + if uu___5 + then FStar_Options.pop () + else ()); Obj.magic (FStar_Class_Monad.return FStar_Tactics_Monad.monad_tac @@ -4591,10 +4605,8 @@ let (t_apply_lemma : (( let uu___19 = - FStar_TypeChecker_Env.debug - env1 - (FStar_Options.Other - "2635") in + FStar_Compiler_Effect.op_Bang + dbg_2635 in if uu___19 then @@ -9793,8 +9805,7 @@ let write : let (dbg_refl : env -> (unit -> Prims.string) -> unit) = fun g -> fun msg -> - let uu___ = - FStar_TypeChecker_Env.debug g (FStar_Options.Other "ReflTc") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg_ReflTc in if uu___ then let uu___1 = msg () in FStar_Compiler_Util.print_string uu___1 else () @@ -12656,9 +12667,7 @@ let (proofstate_of_goals : fun imps -> let env2 = tac_env env1 in let ps = - let uu___ = - FStar_TypeChecker_Env.debug env2 - (FStar_Options.Other "TacVerbose") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg_TacVerbose in let uu___1 = FStar_Compiler_Util.psmap_empty () in { FStar_Tactics_Types.main_context = env2; @@ -12814,9 +12823,7 @@ let (proofstate_of_all_implicits : let uu___ = FStar_Compiler_List.hd goals in FStar_Tactics_Types.goal_witness uu___ in let ps = - let uu___ = - FStar_TypeChecker_Env.debug env2 - (FStar_Options.Other "TacVerbose") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg_TacVerbose in let uu___1 = FStar_Compiler_Util.psmap_empty () in { FStar_Tactics_Types.main_context = env2; diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Derived.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Derived.ml index af3561abadb..ce75f790f77 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Derived.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Derived.ml @@ -597,12 +597,12 @@ let (debug : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (162)) (Prims.of_int (7)) (Prims.of_int (162)) + (Prims.of_int (161)) (Prims.of_int (7)) (Prims.of_int (161)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (162)) (Prims.of_int (4)) (Prims.of_int (162)) + (Prims.of_int (161)) (Prims.of_int (4)) (Prims.of_int (161)) (Prims.of_int (32))))) (Obj.magic (FStar_Tactics_V2_Builtins.debugging ())) (fun uu___ -> @@ -620,25 +620,25 @@ let (smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (169)) (Prims.of_int (10)) (Prims.of_int (169)) + (Prims.of_int (168)) (Prims.of_int (10)) (Prims.of_int (168)) (Prims.of_int (32))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (169)) (Prims.of_int (4)) (Prims.of_int (175)) + (Prims.of_int (168)) (Prims.of_int (4)) (Prims.of_int (174)) (Prims.of_int (11))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (169)) (Prims.of_int (10)) - (Prims.of_int (169)) (Prims.of_int (18))))) + (Prims.of_int (168)) (Prims.of_int (10)) + (Prims.of_int (168)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (169)) (Prims.of_int (10)) - (Prims.of_int (169)) (Prims.of_int (32))))) + (Prims.of_int (168)) (Prims.of_int (10)) + (Prims.of_int (168)) (Prims.of_int (32))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -648,14 +648,14 @@ let (smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (169)) (Prims.of_int (20)) - (Prims.of_int (169)) (Prims.of_int (32))))) + (Prims.of_int (168)) (Prims.of_int (20)) + (Prims.of_int (168)) (Prims.of_int (32))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (169)) (Prims.of_int (10)) - (Prims.of_int (169)) (Prims.of_int (32))))) + (Prims.of_int (168)) (Prims.of_int (10)) + (Prims.of_int (168)) (Prims.of_int (32))))) (Obj.magic (smt_goals ())) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -673,14 +673,14 @@ let (smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (173)) (Prims.of_int (8)) - (Prims.of_int (173)) (Prims.of_int (20))))) + (Prims.of_int (172)) (Prims.of_int (8)) + (Prims.of_int (172)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (174)) (Prims.of_int (8)) - (Prims.of_int (174)) (Prims.of_int (32))))) + (Prims.of_int (173)) (Prims.of_int (8)) + (Prims.of_int (173)) (Prims.of_int (32))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_goals gs)) (fun uu___2 -> (fun uu___2 -> @@ -698,12 +698,12 @@ let (later : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (181)) (Prims.of_int (10)) (Prims.of_int (181)) + (Prims.of_int (180)) (Prims.of_int (10)) (Prims.of_int (180)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (181)) (Prims.of_int (4)) (Prims.of_int (183)) + (Prims.of_int (180)) (Prims.of_int (4)) (Prims.of_int (182)) (Prims.of_int (33))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -755,12 +755,12 @@ let (t_pointwise : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (242)) (Prims.of_int (4)) (Prims.of_int (242)) + (Prims.of_int (241)) (Prims.of_int (4)) (Prims.of_int (241)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (243)) (Prims.of_int (4)) (Prims.of_int (247)) + (Prims.of_int (242)) (Prims.of_int (4)) (Prims.of_int (246)) (Prims.of_int (24))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> @@ -778,13 +778,13 @@ let (t_pointwise : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (245)) (Prims.of_int (4)) - (Prims.of_int (245)) (Prims.of_int (10))))) + (Prims.of_int (244)) (Prims.of_int (4)) + (Prims.of_int (244)) (Prims.of_int (10))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (247)) (Prims.of_int (2)) - (Prims.of_int (247)) (Prims.of_int (24))))) + (Prims.of_int (246)) (Prims.of_int (2)) + (Prims.of_int (246)) (Prims.of_int (24))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> fun uu___1 -> tau ())) (fun uu___ -> @@ -805,12 +805,12 @@ let (topdown_rewrite : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (271)) (Prims.of_int (49)) - (Prims.of_int (280)) (Prims.of_int (10))))) + (Prims.of_int (270)) (Prims.of_int (49)) + (Prims.of_int (279)) (Prims.of_int (10))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (282)) (Prims.of_int (4)) (Prims.of_int (282)) + (Prims.of_int (281)) (Prims.of_int (4)) (Prims.of_int (281)) (Prims.of_int (33))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> @@ -819,13 +819,13 @@ let (topdown_rewrite : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (272)) (Prims.of_int (17)) - (Prims.of_int (272)) (Prims.of_int (23))))) + (Prims.of_int (271)) (Prims.of_int (17)) + (Prims.of_int (271)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (271)) (Prims.of_int (49)) - (Prims.of_int (280)) (Prims.of_int (10))))) + (Prims.of_int (270)) (Prims.of_int (49)) + (Prims.of_int (279)) (Prims.of_int (10))))) (Obj.magic (ctrl t)) (fun uu___1 -> (fun uu___1 -> @@ -837,17 +837,17 @@ let (topdown_rewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (274)) + (Prims.of_int (273)) (Prims.of_int (8)) - (Prims.of_int (278)) + (Prims.of_int (277)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (280)) + (Prims.of_int (279)) (Prims.of_int (6)) - (Prims.of_int (280)) + (Prims.of_int (279)) (Prims.of_int (10))))) (match i with | uu___2 when uu___2 = Prims.int_zero -> @@ -890,12 +890,12 @@ let (cur_module : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (288)) (Prims.of_int (13)) (Prims.of_int (288)) + (Prims.of_int (287)) (Prims.of_int (13)) (Prims.of_int (287)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (288)) (Prims.of_int (4)) (Prims.of_int (288)) + (Prims.of_int (287)) (Prims.of_int (4)) (Prims.of_int (287)) (Prims.of_int (25))))) (Obj.magic (FStar_Tactics_V2_Builtins.top_env ())) (fun uu___1 -> @@ -911,12 +911,12 @@ let (open_modules : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (291)) (Prims.of_int (21)) (Prims.of_int (291)) + (Prims.of_int (290)) (Prims.of_int (21)) (Prims.of_int (290)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (291)) (Prims.of_int (4)) (Prims.of_int (291)) + (Prims.of_int (290)) (Prims.of_int (4)) (Prims.of_int (290)) (Prims.of_int (33))))) (Obj.magic (FStar_Tactics_V2_Builtins.top_env ())) (fun uu___1 -> @@ -932,12 +932,12 @@ let (fresh_uvar : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (294)) (Prims.of_int (12)) (Prims.of_int (294)) + (Prims.of_int (293)) (Prims.of_int (12)) (Prims.of_int (293)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (295)) (Prims.of_int (4)) (Prims.of_int (295)) + (Prims.of_int (294)) (Prims.of_int (4)) (Prims.of_int (294)) (Prims.of_int (16))))) (Obj.magic (cur_env ())) (fun uu___ -> (fun e -> Obj.magic (FStar_Tactics_V2_Builtins.uvar_env e o)) uu___) @@ -952,12 +952,12 @@ let (unify : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (298)) (Prims.of_int (12)) - (Prims.of_int (298)) (Prims.of_int (22))))) + (Prims.of_int (297)) (Prims.of_int (12)) + (Prims.of_int (297)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (299)) (Prims.of_int (4)) (Prims.of_int (299)) + (Prims.of_int (298)) (Prims.of_int (4)) (Prims.of_int (298)) (Prims.of_int (21))))) (Obj.magic (cur_env ())) (fun uu___ -> (fun e -> Obj.magic (FStar_Tactics_V2_Builtins.unify_env e t1 t2)) @@ -973,12 +973,12 @@ let (unify_guard : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (302)) (Prims.of_int (12)) - (Prims.of_int (302)) (Prims.of_int (22))))) + (Prims.of_int (301)) (Prims.of_int (12)) + (Prims.of_int (301)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (303)) (Prims.of_int (4)) (Prims.of_int (303)) + (Prims.of_int (302)) (Prims.of_int (4)) (Prims.of_int (302)) (Prims.of_int (27))))) (Obj.magic (cur_env ())) (fun uu___ -> (fun e -> @@ -995,12 +995,12 @@ let (tmatch : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (306)) (Prims.of_int (12)) - (Prims.of_int (306)) (Prims.of_int (22))))) + (Prims.of_int (305)) (Prims.of_int (12)) + (Prims.of_int (305)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (307)) (Prims.of_int (4)) (Prims.of_int (307)) + (Prims.of_int (306)) (Prims.of_int (4)) (Prims.of_int (306)) (Prims.of_int (21))))) (Obj.magic (cur_env ())) (fun uu___ -> (fun e -> Obj.magic (FStar_Tactics_V2_Builtins.match_env e t1 t2)) @@ -1019,13 +1019,13 @@ let divide : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (313)) (Prims.of_int (4)) - (Prims.of_int (314)) (Prims.of_int (31))))) + (Prims.of_int (312)) (Prims.of_int (4)) + (Prims.of_int (313)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (314)) (Prims.of_int (32)) - (Prims.of_int (327)) (Prims.of_int (10))))) + (Prims.of_int (313)) (Prims.of_int (32)) + (Prims.of_int (326)) (Prims.of_int (10))))) (if n < Prims.int_zero then fail "divide: negative n" else FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())) @@ -1037,28 +1037,28 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (315)) (Prims.of_int (18)) - (Prims.of_int (315)) (Prims.of_int (40))))) + (Prims.of_int (314)) (Prims.of_int (18)) + (Prims.of_int (314)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (314)) (Prims.of_int (32)) - (Prims.of_int (327)) (Prims.of_int (10))))) + (Prims.of_int (313)) (Prims.of_int (32)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (315)) (Prims.of_int (18)) - (Prims.of_int (315)) (Prims.of_int (26))))) + (Prims.of_int (314)) (Prims.of_int (18)) + (Prims.of_int (314)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (315)) (Prims.of_int (18)) - (Prims.of_int (315)) (Prims.of_int (40))))) + (Prims.of_int (314)) (Prims.of_int (18)) + (Prims.of_int (314)) (Prims.of_int (40))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -1068,17 +1068,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (315)) + (Prims.of_int (314)) (Prims.of_int (28)) - (Prims.of_int (315)) + (Prims.of_int (314)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (315)) + (Prims.of_int (314)) (Prims.of_int (18)) - (Prims.of_int (315)) + (Prims.of_int (314)) (Prims.of_int (40))))) (Obj.magic (smt_goals ())) (fun uu___2 -> @@ -1095,17 +1095,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (316)) + (Prims.of_int (315)) (Prims.of_int (19)) - (Prims.of_int (316)) + (Prims.of_int (315)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (315)) + (Prims.of_int (314)) (Prims.of_int (43)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> @@ -1120,17 +1120,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (318)) + (Prims.of_int (317)) (Prims.of_int (4)) - (Prims.of_int (318)) + (Prims.of_int (317)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (318)) + (Prims.of_int (317)) (Prims.of_int (19)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_goals @@ -1144,18 +1144,18 @@ let divide : ( FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (318)) + (Prims.of_int (317)) (Prims.of_int (19)) - (Prims.of_int (318)) + (Prims.of_int (317)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic ( FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (318)) + (Prims.of_int (317)) (Prims.of_int (36)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_smt_goals @@ -1169,17 +1169,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (319)) + (Prims.of_int (318)) (Prims.of_int (12)) - (Prims.of_int (319)) + (Prims.of_int (318)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (319)) + (Prims.of_int (318)) (Prims.of_int (19)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (l ())) @@ -1192,17 +1192,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (20)) - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (319)) + (Prims.of_int (318)) (Prims.of_int (19)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1210,17 +1210,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (20)) - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (20)) - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (42))))) (Obj.magic (goals ())) @@ -1234,17 +1234,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (30)) - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (20)) - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (42))))) (Obj.magic (smt_goals @@ -1272,17 +1272,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (4)) - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (19)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_goals @@ -1297,17 +1297,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (19)) - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (36)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_smt_goals @@ -1322,17 +1322,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (323)) + (Prims.of_int (322)) (Prims.of_int (12)) - (Prims.of_int (323)) + (Prims.of_int (322)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (323)) + (Prims.of_int (322)) (Prims.of_int (19)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (r ())) @@ -1345,17 +1345,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (20)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (323)) + (Prims.of_int (322)) (Prims.of_int (19)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1363,17 +1363,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (20)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (20)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (42))))) (Obj.magic (goals ())) @@ -1387,17 +1387,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (30)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (20)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (42))))) (Obj.magic (smt_goals @@ -1426,17 +1426,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (326)) + (Prims.of_int (325)) (Prims.of_int (4)) - (Prims.of_int (326)) + (Prims.of_int (325)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (326)) + (Prims.of_int (325)) (Prims.of_int (27)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_goals @@ -1453,17 +1453,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (326)) + (Prims.of_int (325)) (Prims.of_int (27)) - (Prims.of_int (326)) + (Prims.of_int (325)) (Prims.of_int (60))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (4)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_smt_goals @@ -1503,13 +1503,13 @@ let rec (iseq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (331)) (Prims.of_int (23)) - (Prims.of_int (331)) (Prims.of_int (53))))) + (Prims.of_int (330)) (Prims.of_int (23)) + (Prims.of_int (330)) (Prims.of_int (53))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (331)) (Prims.of_int (57)) - (Prims.of_int (331)) (Prims.of_int (59))))) + (Prims.of_int (330)) (Prims.of_int (57)) + (Prims.of_int (330)) (Prims.of_int (59))))) (Obj.magic (divide Prims.int_one t (fun uu___ -> iseq ts1))) (fun uu___ -> @@ -1528,12 +1528,12 @@ let focus : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (337)) (Prims.of_int (10)) (Prims.of_int (337)) + (Prims.of_int (336)) (Prims.of_int (10)) (Prims.of_int (336)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (337)) (Prims.of_int (4)) (Prims.of_int (344)) + (Prims.of_int (336)) (Prims.of_int (4)) (Prims.of_int (343)) (Prims.of_int (9))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -1547,14 +1547,14 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (340)) (Prims.of_int (18)) - (Prims.of_int (340)) (Prims.of_int (30))))) + (Prims.of_int (339)) (Prims.of_int (18)) + (Prims.of_int (339)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (341)) (Prims.of_int (8)) - (Prims.of_int (344)) (Prims.of_int (9))))) + (Prims.of_int (340)) (Prims.of_int (8)) + (Prims.of_int (343)) (Prims.of_int (9))))) (Obj.magic (smt_goals ())) (fun uu___1 -> (fun sgs -> @@ -1564,17 +1564,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (341)) + (Prims.of_int (340)) (Prims.of_int (8)) - (Prims.of_int (341)) + (Prims.of_int (340)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (341)) + (Prims.of_int (340)) (Prims.of_int (23)) - (Prims.of_int (344)) + (Prims.of_int (343)) (Prims.of_int (9))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_goals @@ -1587,17 +1587,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (341)) + (Prims.of_int (340)) (Prims.of_int (23)) - (Prims.of_int (341)) + (Prims.of_int (340)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (341)) + (Prims.of_int (340)) (Prims.of_int (40)) - (Prims.of_int (344)) + (Prims.of_int (343)) (Prims.of_int (9))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_smt_goals @@ -1610,17 +1610,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (342)) + (Prims.of_int (341)) (Prims.of_int (16)) - (Prims.of_int (342)) + (Prims.of_int (341)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (8)) - (Prims.of_int (344)) + (Prims.of_int (343)) (Prims.of_int (9))))) (Obj.magic (t ())) (fun uu___3 -> @@ -1632,18 +1632,18 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (8)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (33))))) ( FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (35)) - (Prims.of_int (344)) + (Prims.of_int (343)) (Prims.of_int (9))))) ( Obj.magic @@ -1652,17 +1652,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (18)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (8)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (33))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1670,17 +1670,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (19)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (18)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (33))))) (Obj.magic (goals ())) @@ -1710,17 +1710,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (35)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (69))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (342)) + (Prims.of_int (341)) (Prims.of_int (12)) - (Prims.of_int (342)) + (Prims.of_int (341)) (Prims.of_int (13))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1728,17 +1728,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (49)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (69))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (35)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (69))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1746,17 +1746,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (50)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (62))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (49)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (69))))) (Obj.magic (smt_goals @@ -1799,12 +1799,12 @@ let rec mapAll : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (350)) (Prims.of_int (10)) (Prims.of_int (350)) + (Prims.of_int (349)) (Prims.of_int (10)) (Prims.of_int (349)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (350)) (Prims.of_int (4)) (Prims.of_int (352)) + (Prims.of_int (349)) (Prims.of_int (4)) (Prims.of_int (351)) (Prims.of_int (66))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -1821,14 +1821,14 @@ let rec mapAll : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (352)) (Prims.of_int (27)) - (Prims.of_int (352)) (Prims.of_int (58))))) + (Prims.of_int (351)) (Prims.of_int (27)) + (Prims.of_int (351)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (352)) (Prims.of_int (13)) - (Prims.of_int (352)) (Prims.of_int (66))))) + (Prims.of_int (351)) (Prims.of_int (13)) + (Prims.of_int (351)) (Prims.of_int (66))))) (Obj.magic (divide Prims.int_one t (fun uu___3 -> mapAll t))) (fun uu___3 -> @@ -1845,12 +1845,12 @@ let rec (iterAll : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (356)) (Prims.of_int (10)) (Prims.of_int (356)) + (Prims.of_int (355)) (Prims.of_int (10)) (Prims.of_int (355)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (356)) (Prims.of_int (4)) (Prims.of_int (358)) + (Prims.of_int (355)) (Prims.of_int (4)) (Prims.of_int (357)) (Prims.of_int (60))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -1867,14 +1867,14 @@ let rec (iterAll : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (358)) (Prims.of_int (22)) - (Prims.of_int (358)) (Prims.of_int (54))))) + (Prims.of_int (357)) (Prims.of_int (22)) + (Prims.of_int (357)) (Prims.of_int (54))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (358)) (Prims.of_int (58)) - (Prims.of_int (358)) (Prims.of_int (60))))) + (Prims.of_int (357)) (Prims.of_int (58)) + (Prims.of_int (357)) (Prims.of_int (60))))) (Obj.magic (divide Prims.int_one t (fun uu___3 -> iterAll t))) (fun uu___3 -> @@ -1889,25 +1889,25 @@ let (iterAllSMT : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (361)) (Prims.of_int (18)) (Prims.of_int (361)) + (Prims.of_int (360)) (Prims.of_int (18)) (Prims.of_int (360)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (360)) (Prims.of_int (50)) (Prims.of_int (367)) + (Prims.of_int (359)) (Prims.of_int (50)) (Prims.of_int (366)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (361)) (Prims.of_int (18)) - (Prims.of_int (361)) (Prims.of_int (26))))) + (Prims.of_int (360)) (Prims.of_int (18)) + (Prims.of_int (360)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (361)) (Prims.of_int (18)) - (Prims.of_int (361)) (Prims.of_int (40))))) + (Prims.of_int (360)) (Prims.of_int (18)) + (Prims.of_int (360)) (Prims.of_int (40))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -1917,14 +1917,14 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (361)) (Prims.of_int (28)) - (Prims.of_int (361)) (Prims.of_int (40))))) + (Prims.of_int (360)) (Prims.of_int (28)) + (Prims.of_int (360)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (361)) (Prims.of_int (18)) - (Prims.of_int (361)) (Prims.of_int (40))))) + (Prims.of_int (360)) (Prims.of_int (18)) + (Prims.of_int (360)) (Prims.of_int (40))))) (Obj.magic (smt_goals ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -1939,14 +1939,14 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (362)) (Prims.of_int (4)) - (Prims.of_int (362)) (Prims.of_int (17))))) + (Prims.of_int (361)) (Prims.of_int (4)) + (Prims.of_int (361)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (363)) (Prims.of_int (4)) - (Prims.of_int (367)) (Prims.of_int (28))))) + (Prims.of_int (362)) (Prims.of_int (4)) + (Prims.of_int (366)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_goals sgs)) (fun uu___1 -> (fun uu___1 -> @@ -1956,17 +1956,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (363)) + (Prims.of_int (362)) (Prims.of_int (4)) - (Prims.of_int (363)) + (Prims.of_int (362)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (364)) + (Prims.of_int (363)) (Prims.of_int (4)) - (Prims.of_int (367)) + (Prims.of_int (366)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_smt_goals @@ -1979,17 +1979,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (364)) + (Prims.of_int (363)) (Prims.of_int (4)) - (Prims.of_int (364)) + (Prims.of_int (363)) (Prims.of_int (13))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (364)) + (Prims.of_int (363)) (Prims.of_int (14)) - (Prims.of_int (367)) + (Prims.of_int (366)) (Prims.of_int (28))))) (Obj.magic (iterAll t)) (fun uu___3 -> @@ -2000,17 +2000,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (20)) - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (364)) + (Prims.of_int (363)) (Prims.of_int (14)) - (Prims.of_int (367)) + (Prims.of_int (366)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2018,17 +2018,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (20)) - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (20)) - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (42))))) (Obj.magic (goals ())) @@ -2041,17 +2041,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (30)) - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (20)) - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (42))))) (Obj.magic (smt_goals @@ -2074,17 +2074,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (366)) + (Prims.of_int (365)) (Prims.of_int (4)) - (Prims.of_int (366)) + (Prims.of_int (365)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (367)) + (Prims.of_int (366)) (Prims.of_int (4)) - (Prims.of_int (367)) + (Prims.of_int (366)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_goals @@ -2114,13 +2114,13 @@ let (seq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (373)) (Prims.of_int (21)) - (Prims.of_int (373)) (Prims.of_int (25))))) + (Prims.of_int (372)) (Prims.of_int (21)) + (Prims.of_int (372)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (373)) (Prims.of_int (27)) - (Prims.of_int (373)) (Prims.of_int (36))))) + (Prims.of_int (372)) (Prims.of_int (27)) + (Prims.of_int (372)) (Prims.of_int (36))))) (Obj.magic (f ())) (fun uu___1 -> (fun uu___1 -> Obj.magic (iterAll g)) uu___1)) let (exact_args : @@ -2136,13 +2136,13 @@ let (exact_args : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (377)) (Prims.of_int (16)) - (Prims.of_int (377)) (Prims.of_int (39))))) + (Prims.of_int (376)) (Prims.of_int (16)) + (Prims.of_int (376)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (377)) (Prims.of_int (42)) - (Prims.of_int (383)) (Prims.of_int (44))))) + (Prims.of_int (376)) (Prims.of_int (42)) + (Prims.of_int (382)) (Prims.of_int (44))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> FStar_List_Tot_Base.length qs)) (fun uu___1 -> @@ -2153,14 +2153,14 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (378)) (Prims.of_int (18)) - (Prims.of_int (378)) (Prims.of_int (55))))) + (Prims.of_int (377)) (Prims.of_int (18)) + (Prims.of_int (377)) (Prims.of_int (55))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (378)) (Prims.of_int (58)) - (Prims.of_int (383)) (Prims.of_int (44))))) + (Prims.of_int (377)) (Prims.of_int (58)) + (Prims.of_int (382)) (Prims.of_int (44))))) (Obj.magic (FStar_Tactics_Util.repeatn n (fun uu___1 -> @@ -2173,17 +2173,17 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (379)) + (Prims.of_int (378)) (Prims.of_int (17)) - (Prims.of_int (379)) + (Prims.of_int (378)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (380)) + (Prims.of_int (379)) (Prims.of_int (8)) - (Prims.of_int (383)) + (Prims.of_int (382)) (Prims.of_int (44))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2191,17 +2191,17 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (379)) + (Prims.of_int (378)) (Prims.of_int (26)) - (Prims.of_int (379)) + (Prims.of_int (378)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (379)) + (Prims.of_int (378)) (Prims.of_int (17)) - (Prims.of_int (379)) + (Prims.of_int (378)) (Prims.of_int (38))))) (Obj.magic (FStar_Tactics_Util.zip uvs qs)) @@ -2218,17 +2218,17 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (380)) + (Prims.of_int (379)) (Prims.of_int (8)) - (Prims.of_int (380)) + (Prims.of_int (379)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (381)) + (Prims.of_int (380)) (Prims.of_int (8)) - (Prims.of_int (383)) + (Prims.of_int (382)) (Prims.of_int (44))))) (Obj.magic (exact t')) (fun uu___1 -> @@ -2267,12 +2267,12 @@ let (exact_n : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (387)) (Prims.of_int (15)) - (Prims.of_int (387)) (Prims.of_int (49))))) + (Prims.of_int (386)) (Prims.of_int (15)) + (Prims.of_int (386)) (Prims.of_int (49))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (387)) (Prims.of_int (4)) (Prims.of_int (387)) + (Prims.of_int (386)) (Prims.of_int (4)) (Prims.of_int (386)) (Prims.of_int (51))))) (Obj.magic (FStar_Tactics_Util.repeatn n @@ -2289,12 +2289,12 @@ let (ngoals : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (390)) (Prims.of_int (47)) (Prims.of_int (390)) + (Prims.of_int (389)) (Prims.of_int (47)) (Prims.of_int (389)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (390)) (Prims.of_int (26)) (Prims.of_int (390)) + (Prims.of_int (389)) (Prims.of_int (26)) (Prims.of_int (389)) (Prims.of_int (57))))) (Obj.magic (goals ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2305,12 +2305,12 @@ let (ngoals_smt : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (393)) (Prims.of_int (51)) (Prims.of_int (393)) + (Prims.of_int (392)) (Prims.of_int (51)) (Prims.of_int (392)) (Prims.of_int (65))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (393)) (Prims.of_int (30)) (Prims.of_int (393)) + (Prims.of_int (392)) (Prims.of_int (30)) (Prims.of_int (392)) (Prims.of_int (65))))) (Obj.magic (smt_goals ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2324,12 +2324,12 @@ let (fresh_namedv_named : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (397)) (Prims.of_int (10)) (Prims.of_int (397)) + (Prims.of_int (396)) (Prims.of_int (10)) (Prims.of_int (396)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (398)) (Prims.of_int (2)) (Prims.of_int (402)) + (Prims.of_int (397)) (Prims.of_int (2)) (Prims.of_int (401)) (Prims.of_int (4))))) (Obj.magic (FStar_Tactics_V2_Builtins.fresh ())) (fun n -> @@ -2353,12 +2353,12 @@ let (fresh_namedv : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (407)) (Prims.of_int (10)) (Prims.of_int (407)) + (Prims.of_int (406)) (Prims.of_int (10)) (Prims.of_int (406)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (408)) (Prims.of_int (2)) (Prims.of_int (412)) + (Prims.of_int (407)) (Prims.of_int (2)) (Prims.of_int (411)) (Prims.of_int (4))))) (Obj.magic (FStar_Tactics_V2_Builtins.fresh ())) (fun n -> @@ -2387,12 +2387,12 @@ let (fresh_binder_named : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (415)) (Prims.of_int (10)) - (Prims.of_int (415)) (Prims.of_int (18))))) + (Prims.of_int (414)) (Prims.of_int (10)) + (Prims.of_int (414)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (417)) (Prims.of_int (4)) (Prims.of_int (421)) + (Prims.of_int (416)) (Prims.of_int (4)) (Prims.of_int (420)) (Prims.of_int (17))))) (Obj.magic (FStar_Tactics_V2_Builtins.fresh ())) (fun n -> @@ -2416,12 +2416,12 @@ let (fresh_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (425)) (Prims.of_int (10)) (Prims.of_int (425)) + (Prims.of_int (424)) (Prims.of_int (10)) (Prims.of_int (424)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (427)) (Prims.of_int (4)) (Prims.of_int (431)) + (Prims.of_int (426)) (Prims.of_int (4)) (Prims.of_int (430)) (Prims.of_int (17))))) (Obj.magic (FStar_Tactics_V2_Builtins.fresh ())) (fun n -> @@ -2446,12 +2446,12 @@ let (fresh_implicit_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (435)) (Prims.of_int (10)) (Prims.of_int (435)) + (Prims.of_int (434)) (Prims.of_int (10)) (Prims.of_int (434)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (437)) (Prims.of_int (4)) (Prims.of_int (441)) + (Prims.of_int (436)) (Prims.of_int (4)) (Prims.of_int (440)) (Prims.of_int (17))))) (Obj.magic (FStar_Tactics_V2_Builtins.fresh ())) (fun n -> @@ -2486,12 +2486,12 @@ let try_with : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (455)) (Prims.of_int (10)) - (Prims.of_int (455)) (Prims.of_int (17))))) + (Prims.of_int (454)) (Prims.of_int (10)) + (Prims.of_int (454)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (455)) (Prims.of_int (4)) (Prims.of_int (457)) + (Prims.of_int (454)) (Prims.of_int (4)) (Prims.of_int (456)) (Prims.of_int (16))))) (Obj.magic (FStar_Tactics_V2_Builtins.catch f)) (fun uu___ -> @@ -2517,13 +2517,13 @@ let trytac : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (460)) (Prims.of_int (13)) - (Prims.of_int (460)) (Prims.of_int (19))))) + (Prims.of_int (459)) (Prims.of_int (13)) + (Prims.of_int (459)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (460)) (Prims.of_int (8)) - (Prims.of_int (460)) (Prims.of_int (19))))) + (Prims.of_int (459)) (Prims.of_int (8)) + (Prims.of_int (459)) (Prims.of_int (19))))) (Obj.magic (t ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2568,12 +2568,12 @@ let rec repeat : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (477)) (Prims.of_int (10)) (Prims.of_int (477)) + (Prims.of_int (476)) (Prims.of_int (10)) (Prims.of_int (476)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (477)) (Prims.of_int (4)) (Prims.of_int (479)) + (Prims.of_int (476)) (Prims.of_int (4)) (Prims.of_int (478)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V2_Builtins.catch t)) (fun uu___ -> @@ -2591,14 +2591,14 @@ let rec repeat : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (479)) (Prims.of_int (20)) - (Prims.of_int (479)) (Prims.of_int (28))))) + (Prims.of_int (478)) (Prims.of_int (20)) + (Prims.of_int (478)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (479)) (Prims.of_int (15)) - (Prims.of_int (479)) (Prims.of_int (28))))) + (Prims.of_int (478)) (Prims.of_int (15)) + (Prims.of_int (478)) (Prims.of_int (28))))) (Obj.magic (repeat t)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2613,12 +2613,12 @@ let repeat1 : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (482)) (Prims.of_int (4)) (Prims.of_int (482)) + (Prims.of_int (481)) (Prims.of_int (4)) (Prims.of_int (481)) (Prims.of_int (8))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (482)) (Prims.of_int (4)) (Prims.of_int (482)) + (Prims.of_int (481)) (Prims.of_int (4)) (Prims.of_int (481)) (Prims.of_int (20))))) (Obj.magic (t ())) (fun uu___ -> (fun uu___ -> @@ -2627,13 +2627,13 @@ let repeat1 : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (482)) (Prims.of_int (12)) - (Prims.of_int (482)) (Prims.of_int (20))))) + (Prims.of_int (481)) (Prims.of_int (12)) + (Prims.of_int (481)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (482)) (Prims.of_int (4)) - (Prims.of_int (482)) (Prims.of_int (20))))) + (Prims.of_int (481)) (Prims.of_int (4)) + (Prims.of_int (481)) (Prims.of_int (20))))) (Obj.magic (repeat t)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2648,12 +2648,12 @@ let repeat' : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (485)) (Prims.of_int (12)) (Prims.of_int (485)) + (Prims.of_int (484)) (Prims.of_int (12)) (Prims.of_int (484)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (485)) (Prims.of_int (24)) (Prims.of_int (485)) + (Prims.of_int (484)) (Prims.of_int (24)) (Prims.of_int (484)) (Prims.of_int (26))))) (Obj.magic (repeat f)) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())) let (norm_term : @@ -2667,12 +2667,12 @@ let (norm_term : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (489)) (Prims.of_int (8)) (Prims.of_int (490)) + (Prims.of_int (488)) (Prims.of_int (8)) (Prims.of_int (489)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (492)) (Prims.of_int (4)) (Prims.of_int (492)) + (Prims.of_int (491)) (Prims.of_int (4)) (Prims.of_int (491)) (Prims.of_int (23))))) (Obj.magic (try_with (fun uu___ -> match () with | () -> cur_env ()) @@ -2688,25 +2688,25 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (499)) (Prims.of_int (16)) (Prims.of_int (499)) + (Prims.of_int (498)) (Prims.of_int (16)) (Prims.of_int (498)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (498)) (Prims.of_int (27)) (Prims.of_int (505)) + (Prims.of_int (497)) (Prims.of_int (27)) (Prims.of_int (504)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (499)) (Prims.of_int (16)) - (Prims.of_int (499)) (Prims.of_int (24))))) + (Prims.of_int (498)) (Prims.of_int (16)) + (Prims.of_int (498)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (499)) (Prims.of_int (16)) - (Prims.of_int (499)) (Prims.of_int (38))))) + (Prims.of_int (498)) (Prims.of_int (16)) + (Prims.of_int (498)) (Prims.of_int (38))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -2716,14 +2716,14 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (499)) (Prims.of_int (26)) - (Prims.of_int (499)) (Prims.of_int (38))))) + (Prims.of_int (498)) (Prims.of_int (26)) + (Prims.of_int (498)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (499)) (Prims.of_int (16)) - (Prims.of_int (499)) (Prims.of_int (38))))) + (Prims.of_int (498)) (Prims.of_int (16)) + (Prims.of_int (498)) (Prims.of_int (38))))) (Obj.magic (smt_goals ())) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -2738,14 +2738,14 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (500)) (Prims.of_int (2)) - (Prims.of_int (500)) (Prims.of_int (18))))) + (Prims.of_int (499)) (Prims.of_int (2)) + (Prims.of_int (499)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (501)) (Prims.of_int (2)) - (Prims.of_int (505)) (Prims.of_int (20))))) + (Prims.of_int (500)) (Prims.of_int (2)) + (Prims.of_int (504)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_smt_goals [])) (fun uu___2 -> (fun uu___2 -> @@ -2755,17 +2755,17 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (501)) + (Prims.of_int (500)) (Prims.of_int (2)) - (Prims.of_int (501)) + (Prims.of_int (500)) (Prims.of_int (15))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (502)) + (Prims.of_int (501)) (Prims.of_int (2)) - (Prims.of_int (505)) + (Prims.of_int (504)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_goals sgs)) @@ -2777,17 +2777,17 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (502)) + (Prims.of_int (501)) (Prims.of_int (2)) - (Prims.of_int (502)) + (Prims.of_int (501)) (Prims.of_int (14))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (502)) + (Prims.of_int (501)) (Prims.of_int (15)) - (Prims.of_int (505)) + (Prims.of_int (504)) (Prims.of_int (20))))) (Obj.magic (repeat' @@ -2800,17 +2800,17 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (503)) + (Prims.of_int (502)) (Prims.of_int (13)) - (Prims.of_int (503)) + (Prims.of_int (502)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (504)) + (Prims.of_int (503)) (Prims.of_int (2)) - (Prims.of_int (505)) + (Prims.of_int (504)) (Prims.of_int (20))))) (Obj.magic (goals ())) (fun uu___5 -> @@ -2822,18 +2822,18 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (504)) + (Prims.of_int (503)) (Prims.of_int (2)) - (Prims.of_int (504)) + (Prims.of_int (503)) (Prims.of_int (14))))) (FStar_Sealed.seal ( Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (505)) + (Prims.of_int (504)) (Prims.of_int (2)) - (Prims.of_int (505)) + (Prims.of_int (504)) (Prims.of_int (20))))) (Obj.magic ( @@ -2860,13 +2860,13 @@ let discard : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (508)) (Prims.of_int (22)) - (Prims.of_int (508)) (Prims.of_int (28))))) + (Prims.of_int (507)) (Prims.of_int (22)) + (Prims.of_int (507)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (508)) (Prims.of_int (32)) - (Prims.of_int (508)) (Prims.of_int (34))))) + (Prims.of_int (507)) (Prims.of_int (32)) + (Prims.of_int (507)) (Prims.of_int (34))))) (Obj.magic (tau ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let rec repeatseq : @@ -2879,12 +2879,12 @@ let rec repeatseq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (512)) (Prims.of_int (12)) (Prims.of_int (512)) + (Prims.of_int (511)) (Prims.of_int (12)) (Prims.of_int (511)) (Prims.of_int (82))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (512)) (Prims.of_int (86)) (Prims.of_int (512)) + (Prims.of_int (511)) (Prims.of_int (86)) (Prims.of_int (511)) (Prims.of_int (88))))) (Obj.magic (trytac @@ -2904,12 +2904,12 @@ let (admit_all : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (520)) (Prims.of_int (12)) (Prims.of_int (520)) + (Prims.of_int (519)) (Prims.of_int (12)) (Prims.of_int (519)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (521)) (Prims.of_int (4)) (Prims.of_int (521)) + (Prims.of_int (520)) (Prims.of_int (4)) (Prims.of_int (520)) (Prims.of_int (6))))) (Obj.magic (repeat tadmit)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let (is_guard : unit -> (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) = @@ -2918,12 +2918,12 @@ let (is_guard : unit -> (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (525)) (Prims.of_int (33)) (Prims.of_int (525)) + (Prims.of_int (524)) (Prims.of_int (33)) (Prims.of_int (524)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (525)) (Prims.of_int (4)) (Prims.of_int (525)) + (Prims.of_int (524)) (Prims.of_int (4)) (Prims.of_int (524)) (Prims.of_int (47))))) (Obj.magic (_cur_goal ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2934,12 +2934,12 @@ let (skip_guard : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (528)) (Prims.of_int (7)) (Prims.of_int (528)) + (Prims.of_int (527)) (Prims.of_int (7)) (Prims.of_int (527)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (528)) (Prims.of_int (4)) (Prims.of_int (530)) + (Prims.of_int (527)) (Prims.of_int (4)) (Prims.of_int (529)) (Prims.of_int (16))))) (Obj.magic (is_guard ())) (fun uu___1 -> (fun uu___1 -> @@ -2952,12 +2952,12 @@ let (guards_to_smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (533)) (Prims.of_int (12)) (Prims.of_int (533)) + (Prims.of_int (532)) (Prims.of_int (12)) (Prims.of_int (532)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (534)) (Prims.of_int (4)) (Prims.of_int (534)) + (Prims.of_int (533)) (Prims.of_int (4)) (Prims.of_int (533)) (Prims.of_int (6))))) (Obj.magic (repeat skip_guard)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let (simpl : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = @@ -2989,12 +2989,12 @@ let (intros' : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (542)) (Prims.of_int (36)) (Prims.of_int (542)) + (Prims.of_int (541)) (Prims.of_int (36)) (Prims.of_int (541)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (542)) (Prims.of_int (49)) (Prims.of_int (542)) + (Prims.of_int (541)) (Prims.of_int (49)) (Prims.of_int (541)) (Prims.of_int (51))))) (Obj.magic (intros ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let (destruct : @@ -3005,12 +3005,12 @@ let (destruct : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (543)) (Prims.of_int (37)) (Prims.of_int (543)) + (Prims.of_int (542)) (Prims.of_int (37)) (Prims.of_int (542)) (Prims.of_int (50))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (543)) (Prims.of_int (54)) (Prims.of_int (543)) + (Prims.of_int (542)) (Prims.of_int (54)) (Prims.of_int (542)) (Prims.of_int (56))))) (Obj.magic (FStar_Tactics_V2_Builtins.t_destruct tm)) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())) @@ -3024,13 +3024,13 @@ let (destruct_intros : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (544)) (Prims.of_int (59)) - (Prims.of_int (544)) (Prims.of_int (72))))) + (Prims.of_int (543)) (Prims.of_int (59)) + (Prims.of_int (543)) (Prims.of_int (72))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (544)) (Prims.of_int (76)) - (Prims.of_int (544)) (Prims.of_int (78))))) + (Prims.of_int (543)) (Prims.of_int (76)) + (Prims.of_int (543)) (Prims.of_int (78))))) (Obj.magic (FStar_Tactics_V2_Builtins.t_destruct tm)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ()))) intros' @@ -3044,12 +3044,12 @@ let (tcut : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (550)) (Prims.of_int (12)) (Prims.of_int (550)) + (Prims.of_int (549)) (Prims.of_int (12)) (Prims.of_int (549)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (550)) (Prims.of_int (26)) (Prims.of_int (553)) + (Prims.of_int (549)) (Prims.of_int (26)) (Prims.of_int (552)) (Prims.of_int (12))))) (Obj.magic (cur_goal ())) (fun uu___ -> (fun g -> @@ -3058,13 +3058,13 @@ let (tcut : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (551)) (Prims.of_int (13)) - (Prims.of_int (551)) (Prims.of_int (37))))) + (Prims.of_int (550)) (Prims.of_int (13)) + (Prims.of_int (550)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (552)) (Prims.of_int (4)) - (Prims.of_int (553)) (Prims.of_int (12))))) + (Prims.of_int (551)) (Prims.of_int (4)) + (Prims.of_int (552)) (Prims.of_int (12))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Reflection_V2_Derived.mk_e_app @@ -3084,14 +3084,14 @@ let (tcut : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (552)) (Prims.of_int (4)) - (Prims.of_int (552)) (Prims.of_int (12))))) + (Prims.of_int (551)) (Prims.of_int (4)) + (Prims.of_int (551)) (Prims.of_int (12))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (553)) (Prims.of_int (4)) - (Prims.of_int (553)) (Prims.of_int (12))))) + (Prims.of_int (552)) (Prims.of_int (4)) + (Prims.of_int (552)) (Prims.of_int (12))))) (Obj.magic (apply tt)) (fun uu___ -> (fun uu___ -> @@ -3107,12 +3107,12 @@ let (pose : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (556)) (Prims.of_int (4)) (Prims.of_int (556)) + (Prims.of_int (555)) (Prims.of_int (4)) (Prims.of_int (555)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (557)) (Prims.of_int (4)) (Prims.of_int (559)) + (Prims.of_int (556)) (Prims.of_int (4)) (Prims.of_int (558)) (Prims.of_int (12))))) (Obj.magic (apply @@ -3127,13 +3127,13 @@ let (pose : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (557)) (Prims.of_int (4)) - (Prims.of_int (557)) (Prims.of_int (11))))) + (Prims.of_int (556)) (Prims.of_int (4)) + (Prims.of_int (556)) (Prims.of_int (11))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (558)) (Prims.of_int (4)) - (Prims.of_int (559)) (Prims.of_int (12))))) + (Prims.of_int (557)) (Prims.of_int (4)) + (Prims.of_int (558)) (Prims.of_int (12))))) (Obj.magic (flip ())) (fun uu___1 -> (fun uu___1 -> @@ -3143,14 +3143,14 @@ let (pose : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (558)) (Prims.of_int (4)) - (Prims.of_int (558)) (Prims.of_int (11))))) + (Prims.of_int (557)) (Prims.of_int (4)) + (Prims.of_int (557)) (Prims.of_int (11))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (559)) (Prims.of_int (4)) - (Prims.of_int (559)) (Prims.of_int (12))))) + (Prims.of_int (558)) (Prims.of_int (4)) + (Prims.of_int (558)) (Prims.of_int (12))))) (Obj.magic (exact t)) (fun uu___2 -> (fun uu___2 -> @@ -3166,12 +3166,12 @@ let (intro_as : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (562)) (Prims.of_int (12)) (Prims.of_int (562)) + (Prims.of_int (561)) (Prims.of_int (12)) (Prims.of_int (561)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (563)) (Prims.of_int (4)) (Prims.of_int (563)) + (Prims.of_int (562)) (Prims.of_int (4)) (Prims.of_int (562)) (Prims.of_int (17))))) (Obj.magic (FStar_Tactics_V2_Builtins.intro ())) (fun uu___ -> @@ -3187,12 +3187,12 @@ let (pose_as : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (566)) (Prims.of_int (12)) - (Prims.of_int (566)) (Prims.of_int (18))))) + (Prims.of_int (565)) (Prims.of_int (12)) + (Prims.of_int (565)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (567)) (Prims.of_int (4)) (Prims.of_int (567)) + (Prims.of_int (566)) (Prims.of_int (4)) (Prims.of_int (566)) (Prims.of_int (17))))) (Obj.magic (pose t)) (fun uu___ -> (fun b -> Obj.magic (FStar_Tactics_V2_Builtins.rename_to b s)) @@ -3208,12 +3208,12 @@ let for_each_binding : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (570)) (Prims.of_int (10)) (Prims.of_int (570)) + (Prims.of_int (569)) (Prims.of_int (10)) (Prims.of_int (569)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (570)) (Prims.of_int (4)) (Prims.of_int (570)) + (Prims.of_int (569)) (Prims.of_int (4)) (Prims.of_int (569)) (Prims.of_int (23))))) (Obj.magic (cur_vars ())) (fun uu___ -> (fun uu___ -> Obj.magic (FStar_Tactics_Util.map f uu___)) uu___) @@ -3234,13 +3234,13 @@ let rec (revert_all : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (575)) (Prims.of_int (15)) - (Prims.of_int (575)) (Prims.of_int (24))))) + (Prims.of_int (574)) (Prims.of_int (15)) + (Prims.of_int (574)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (576)) (Prims.of_int (13)) - (Prims.of_int (576)) (Prims.of_int (26))))) + (Prims.of_int (575)) (Prims.of_int (13)) + (Prims.of_int (575)) (Prims.of_int (26))))) (Obj.magic (FStar_Tactics_V2_Builtins.revert ())) (fun uu___1 -> (fun uu___1 -> Obj.magic (revert_all tl)) uu___1)))) @@ -3276,17 +3276,17 @@ let rec (__assumption_aux : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (588)) + (Prims.of_int (587)) (Prims.of_int (13)) - (Prims.of_int (588)) + (Prims.of_int (587)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (589)) + (Prims.of_int (588)) (Prims.of_int (13)) - (Prims.of_int (589)) + (Prims.of_int (588)) (Prims.of_int (20))))) (Obj.magic (apply @@ -3309,12 +3309,12 @@ let (assumption : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (593)) (Prims.of_int (21)) (Prims.of_int (593)) + (Prims.of_int (592)) (Prims.of_int (21)) (Prims.of_int (592)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (593)) (Prims.of_int (4)) (Prims.of_int (593)) + (Prims.of_int (592)) (Prims.of_int (4)) (Prims.of_int (592)) (Prims.of_int (34))))) (Obj.magic (cur_vars ())) (fun uu___1 -> (fun uu___1 -> Obj.magic (__assumption_aux uu___1)) uu___1) @@ -3329,12 +3329,12 @@ let (destruct_equality_implication : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (596)) (Prims.of_int (10)) (Prims.of_int (596)) + (Prims.of_int (595)) (Prims.of_int (10)) (Prims.of_int (595)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (596)) (Prims.of_int (4)) (Prims.of_int (603)) + (Prims.of_int (595)) (Prims.of_int (4)) (Prims.of_int (602)) (Prims.of_int (15))))) (Obj.magic (FStar_Reflection_V2_Formula.term_as_formula t)) (fun uu___ -> @@ -3348,14 +3348,14 @@ let (destruct_equality_implication : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (598)) (Prims.of_int (18)) - (Prims.of_int (598)) (Prims.of_int (38))))) + (Prims.of_int (597)) (Prims.of_int (18)) + (Prims.of_int (597)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (599)) (Prims.of_int (14)) - (Prims.of_int (601)) (Prims.of_int (19))))) + (Prims.of_int (598)) (Prims.of_int (14)) + (Prims.of_int (600)) (Prims.of_int (19))))) (Obj.magic (FStar_Reflection_V2_Formula.term_as_formula' lhs)) (fun lhs1 -> @@ -3385,13 +3385,13 @@ let (rewrite' : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (612)) (Prims.of_int (20)) - (Prims.of_int (612)) (Prims.of_int (32))))) + (Prims.of_int (611)) (Prims.of_int (20)) + (Prims.of_int (611)) (Prims.of_int (32))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (613)) (Prims.of_int (20)) - (Prims.of_int (614)) (Prims.of_int (29))))) + (Prims.of_int (612)) (Prims.of_int (20)) + (Prims.of_int (613)) (Prims.of_int (29))))) (Obj.magic (FStar_Tactics_V2_Builtins.var_retype x)) (fun uu___1 -> (fun uu___1 -> @@ -3401,14 +3401,14 @@ let (rewrite' : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (613)) (Prims.of_int (20)) - (Prims.of_int (613)) (Prims.of_int (43))))) + (Prims.of_int (612)) (Prims.of_int (20)) + (Prims.of_int (612)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (614)) (Prims.of_int (20)) - (Prims.of_int (614)) (Prims.of_int (29))))) + (Prims.of_int (613)) (Prims.of_int (20)) + (Prims.of_int (613)) (Prims.of_int (29))))) (Obj.magic (apply_lemma (FStar_Reflection_V2_Builtins.pack_ln @@ -3448,14 +3448,14 @@ let rec (try_rewrite_equality : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (622)) (Prims.of_int (20)) - (Prims.of_int (622)) (Prims.of_int (57))))) + (Prims.of_int (621)) (Prims.of_int (20)) + (Prims.of_int (621)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (622)) (Prims.of_int (14)) - (Prims.of_int (628)) (Prims.of_int (37))))) + (Prims.of_int (621)) (Prims.of_int (14)) + (Prims.of_int (627)) (Prims.of_int (37))))) (Obj.magic (FStar_Reflection_V2_Formula.term_as_formula (type_of_binding x_t))) @@ -3491,13 +3491,13 @@ let rec (rewrite_all_context_equalities : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (635)) (Prims.of_int (8)) - (Prims.of_int (635)) (Prims.of_int (40))))) + (Prims.of_int (634)) (Prims.of_int (8)) + (Prims.of_int (634)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (636)) (Prims.of_int (8)) - (Prims.of_int (636)) (Prims.of_int (41))))) + (Prims.of_int (635)) (Prims.of_int (8)) + (Prims.of_int (635)) (Prims.of_int (41))))) (Obj.magic (try_with (fun uu___ -> @@ -3519,12 +3519,12 @@ let (rewrite_eqs_from_context : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (640)) (Prims.of_int (35)) (Prims.of_int (640)) + (Prims.of_int (639)) (Prims.of_int (35)) (Prims.of_int (639)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (640)) (Prims.of_int (4)) (Prims.of_int (640)) + (Prims.of_int (639)) (Prims.of_int (4)) (Prims.of_int (639)) (Prims.of_int (48))))) (Obj.magic (cur_vars ())) (fun uu___1 -> (fun uu___1 -> Obj.magic (rewrite_all_context_equalities uu___1)) @@ -3537,12 +3537,12 @@ let (rewrite_equality : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (643)) (Prims.of_int (27)) (Prims.of_int (643)) + (Prims.of_int (642)) (Prims.of_int (27)) (Prims.of_int (642)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (643)) (Prims.of_int (4)) (Prims.of_int (643)) + (Prims.of_int (642)) (Prims.of_int (4)) (Prims.of_int (642)) (Prims.of_int (40))))) (Obj.magic (cur_vars ())) (fun uu___ -> (fun uu___ -> Obj.magic (try_rewrite_equality t uu___)) uu___) @@ -3554,12 +3554,12 @@ let (unfold_def : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (646)) (Prims.of_int (10)) (Prims.of_int (646)) + (Prims.of_int (645)) (Prims.of_int (10)) (Prims.of_int (645)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (646)) (Prims.of_int (4)) (Prims.of_int (650)) + (Prims.of_int (645)) (Prims.of_int (4)) (Prims.of_int (649)) (Prims.of_int (46))))) (Obj.magic (FStar_Tactics_NamedView.inspect t)) (fun uu___ -> @@ -3573,14 +3573,14 @@ let (unfold_def : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (648)) (Prims.of_int (16)) - (Prims.of_int (648)) (Prims.of_int (42))))) + (Prims.of_int (647)) (Prims.of_int (16)) + (Prims.of_int (647)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (649)) (Prims.of_int (8)) - (Prims.of_int (649)) (Prims.of_int (30))))) + (Prims.of_int (648)) (Prims.of_int (8)) + (Prims.of_int (648)) (Prims.of_int (30))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> FStar_Reflection_V2_Builtins.implode_qn @@ -3603,12 +3603,12 @@ let (l_to_r : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (657)) (Prims.of_int (8)) (Prims.of_int (660)) + (Prims.of_int (656)) (Prims.of_int (8)) (Prims.of_int (659)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (661)) (Prims.of_int (4)) (Prims.of_int (661)) + (Prims.of_int (660)) (Prims.of_int (4)) (Prims.of_int (660)) (Prims.of_int (28))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> @@ -3617,13 +3617,13 @@ let (l_to_r : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (657)) (Prims.of_int (8)) - (Prims.of_int (660)) (Prims.of_int (31))))) + (Prims.of_int (656)) (Prims.of_int (8)) + (Prims.of_int (659)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (657)) (Prims.of_int (8)) - (Prims.of_int (660)) (Prims.of_int (31))))) + (Prims.of_int (656)) (Prims.of_int (8)) + (Prims.of_int (659)) (Prims.of_int (31))))) (Obj.magic (FStar_Tactics_Util.fold_left (fun uu___3 -> @@ -3672,13 +3672,13 @@ let (grewrite : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (674)) (Prims.of_int (12)) - (Prims.of_int (674)) (Prims.of_int (33))))) + (Prims.of_int (673)) (Prims.of_int (12)) + (Prims.of_int (673)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (674)) (Prims.of_int (36)) - (Prims.of_int (688)) (Prims.of_int (44))))) + (Prims.of_int (673)) (Prims.of_int (36)) + (Prims.of_int (687)) (Prims.of_int (44))))) (Obj.magic (tcut (mk_sq_eq t1 t2))) (fun uu___ -> (fun e -> @@ -3687,13 +3687,13 @@ let (grewrite : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (675)) (Prims.of_int (12)) - (Prims.of_int (675)) (Prims.of_int (27))))) + (Prims.of_int (674)) (Prims.of_int (12)) + (Prims.of_int (674)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (676)) (Prims.of_int (4)) - (Prims.of_int (688)) (Prims.of_int (44))))) + (Prims.of_int (675)) (Prims.of_int (4)) + (Prims.of_int (687)) (Prims.of_int (44))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Tactics_NamedView.pack @@ -3710,17 +3710,17 @@ let (grewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (679)) + (Prims.of_int (678)) (Prims.of_int (8)) - (Prims.of_int (684)) + (Prims.of_int (683)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (686)) + (Prims.of_int (685)) (Prims.of_int (6)) - (Prims.of_int (688)) + (Prims.of_int (687)) (Prims.of_int (43))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3728,17 +3728,17 @@ let (grewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (679)) + (Prims.of_int (678)) (Prims.of_int (14)) - (Prims.of_int (679)) + (Prims.of_int (678)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (679)) + (Prims.of_int (678)) (Prims.of_int (8)) - (Prims.of_int (684)) + (Prims.of_int (683)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3746,17 +3746,17 @@ let (grewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (679)) + (Prims.of_int (678)) (Prims.of_int (30)) - (Prims.of_int (679)) + (Prims.of_int (678)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (679)) + (Prims.of_int (678)) (Prims.of_int (14)) - (Prims.of_int (679)) + (Prims.of_int (678)) (Prims.of_int (42))))) (Obj.magic (cur_goal ())) (fun uu___1 -> @@ -3778,17 +3778,17 @@ let (grewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (681)) + (Prims.of_int (680)) (Prims.of_int (17)) - (Prims.of_int (681)) + (Prims.of_int (680)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (681)) + (Prims.of_int (680)) (Prims.of_int (10)) - (Prims.of_int (683)) + (Prims.of_int (682)) (Prims.of_int (24))))) (Obj.magic (FStar_Tactics_NamedView.inspect @@ -3835,12 +3835,12 @@ let (grewrite_eq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (695)) (Prims.of_int (8)) (Prims.of_int (695)) + (Prims.of_int (694)) (Prims.of_int (8)) (Prims.of_int (694)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (695)) (Prims.of_int (2)) (Prims.of_int (707)) + (Prims.of_int (694)) (Prims.of_int (2)) (Prims.of_int (706)) (Prims.of_int (7))))) (Obj.magic (FStar_Reflection_V2_Formula.term_as_formula (type_of_binding b))) @@ -3855,14 +3855,14 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (697)) (Prims.of_int (4)) - (Prims.of_int (697)) (Prims.of_int (16))))) + (Prims.of_int (696)) (Prims.of_int (4)) + (Prims.of_int (696)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (698)) (Prims.of_int (4)) - (Prims.of_int (698)) (Prims.of_int (37))))) + (Prims.of_int (697)) (Prims.of_int (4)) + (Prims.of_int (697)) (Prims.of_int (37))))) (Obj.magic (grewrite l r)) (fun uu___2 -> (fun uu___2 -> @@ -3880,14 +3880,14 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (700)) (Prims.of_int (16)) - (Prims.of_int (700)) (Prims.of_int (52))))) + (Prims.of_int (699)) (Prims.of_int (16)) + (Prims.of_int (699)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (700)) (Prims.of_int (10)) - (Prims.of_int (706)) (Prims.of_int (56))))) + (Prims.of_int (699)) (Prims.of_int (10)) + (Prims.of_int (705)) (Prims.of_int (56))))) (Obj.magic (FStar_Reflection_V2_Formula.term_as_formula' (type_of_binding b))) @@ -3904,17 +3904,17 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (6)) - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (703)) + (Prims.of_int (702)) (Prims.of_int (6)) - (Prims.of_int (704)) + (Prims.of_int (703)) (Prims.of_int (39))))) (Obj.magic (grewrite l r)) (fun uu___4 -> @@ -3928,17 +3928,17 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (703)) + (Prims.of_int (702)) (Prims.of_int (30)) - (Prims.of_int (703)) + (Prims.of_int (702)) (Prims.of_int (55))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (704)) + (Prims.of_int (703)) (Prims.of_int (30)) - (Prims.of_int (704)) + (Prims.of_int (703)) (Prims.of_int (37))))) (Obj.magic (apply_lemma @@ -3970,12 +3970,12 @@ let (admit_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (711)) (Prims.of_int (2)) (Prims.of_int (711)) + (Prims.of_int (710)) (Prims.of_int (2)) (Prims.of_int (710)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (712)) (Prims.of_int (2)) (Prims.of_int (712)) + (Prims.of_int (711)) (Prims.of_int (2)) (Prims.of_int (711)) (Prims.of_int (16))))) (Obj.magic (FStar_Tactics_V2_Builtins.dump "Admitting")) (fun uu___1 -> @@ -3993,12 +3993,12 @@ let (magic_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (719)) (Prims.of_int (2)) (Prims.of_int (719)) + (Prims.of_int (718)) (Prims.of_int (2)) (Prims.of_int (718)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (720)) (Prims.of_int (2)) (Prims.of_int (722)) + (Prims.of_int (719)) (Prims.of_int (2)) (Prims.of_int (721)) (Prims.of_int (4))))) (Obj.magic (FStar_Tactics_V2_Builtins.dump "Admitting")) (fun uu___1 -> @@ -4008,13 +4008,13 @@ let (magic_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (720)) (Prims.of_int (2)) - (Prims.of_int (720)) (Prims.of_int (16))))) + (Prims.of_int (719)) (Prims.of_int (2)) + (Prims.of_int (719)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (721)) (Prims.of_int (2)) - (Prims.of_int (722)) (Prims.of_int (4))))) + (Prims.of_int (720)) (Prims.of_int (2)) + (Prims.of_int (721)) (Prims.of_int (4))))) (Obj.magic (apply (FStar_Reflection_V2_Builtins.pack_ln @@ -4029,14 +4029,14 @@ let (magic_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (721)) (Prims.of_int (2)) - (Prims.of_int (721)) (Prims.of_int (13))))) + (Prims.of_int (720)) (Prims.of_int (2)) + (Prims.of_int (720)) (Prims.of_int (13))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (722)) (Prims.of_int (2)) - (Prims.of_int (722)) (Prims.of_int (4))))) + (Prims.of_int (721)) (Prims.of_int (2)) + (Prims.of_int (721)) (Prims.of_int (4))))) (Obj.magic (exact (FStar_Reflection_V2_Builtins.pack_ln @@ -4059,13 +4059,13 @@ let (change_with : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (729)) (Prims.of_int (8)) - (Prims.of_int (729)) (Prims.of_int (22))))) + (Prims.of_int (728)) (Prims.of_int (8)) + (Prims.of_int (728)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (730)) (Prims.of_int (8)) - (Prims.of_int (730)) (Prims.of_int (29))))) + (Prims.of_int (729)) (Prims.of_int (8)) + (Prims.of_int (729)) (Prims.of_int (29))))) (Obj.magic (grewrite t1 t2)) (fun uu___1 -> (fun uu___1 -> Obj.magic (iseq [idtac; trivial])) uu___1)) @@ -4089,12 +4089,12 @@ let finish_by : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (737)) (Prims.of_int (12)) (Prims.of_int (737)) + (Prims.of_int (736)) (Prims.of_int (12)) (Prims.of_int (736)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (738)) (Prims.of_int (4)) (Prims.of_int (739)) + (Prims.of_int (737)) (Prims.of_int (4)) (Prims.of_int (738)) (Prims.of_int (5))))) (Obj.magic (t ())) (fun uu___ -> (fun x -> @@ -4103,13 +4103,13 @@ let finish_by : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (738)) (Prims.of_int (4)) - (Prims.of_int (738)) (Prims.of_int (58))))) + (Prims.of_int (737)) (Prims.of_int (4)) + (Prims.of_int (737)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (737)) (Prims.of_int (8)) - (Prims.of_int (737)) (Prims.of_int (9))))) + (Prims.of_int (736)) (Prims.of_int (8)) + (Prims.of_int (736)) (Prims.of_int (9))))) (Obj.magic (or_else qed (fun uu___ -> @@ -4131,13 +4131,13 @@ let solve_then : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (742)) (Prims.of_int (4)) (Prims.of_int (742)) + (Prims.of_int (741)) (Prims.of_int (4)) (Prims.of_int (741)) (Prims.of_int (10))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (742)) (Prims.of_int (11)) - (Prims.of_int (746)) (Prims.of_int (5))))) + (Prims.of_int (741)) (Prims.of_int (11)) + (Prims.of_int (745)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Builtins.dup ())) (fun uu___ -> (fun uu___ -> @@ -4146,13 +4146,13 @@ let solve_then : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (743)) (Prims.of_int (12)) - (Prims.of_int (743)) (Prims.of_int (42))))) + (Prims.of_int (742)) (Prims.of_int (12)) + (Prims.of_int (742)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (743)) (Prims.of_int (45)) - (Prims.of_int (746)) (Prims.of_int (5))))) + (Prims.of_int (742)) (Prims.of_int (45)) + (Prims.of_int (745)) (Prims.of_int (5))))) (Obj.magic (focus (fun uu___1 -> finish_by t1))) (fun uu___1 -> (fun x -> @@ -4162,17 +4162,17 @@ let solve_then : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (744)) + (Prims.of_int (743)) (Prims.of_int (12)) - (Prims.of_int (744)) + (Prims.of_int (743)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (745)) + (Prims.of_int (744)) (Prims.of_int (4)) - (Prims.of_int (746)) + (Prims.of_int (745)) (Prims.of_int (5))))) (Obj.magic (t2 x)) (fun uu___1 -> @@ -4183,17 +4183,17 @@ let solve_then : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (745)) + (Prims.of_int (744)) (Prims.of_int (4)) - (Prims.of_int (745)) + (Prims.of_int (744)) (Prims.of_int (12))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (744)) + (Prims.of_int (743)) (Prims.of_int (8)) - (Prims.of_int (744)) + (Prims.of_int (743)) (Prims.of_int (9))))) (Obj.magic (trefl ())) (fun uu___1 -> @@ -4212,13 +4212,13 @@ let add_elem : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (749)) (Prims.of_int (4)) - (Prims.of_int (749)) (Prims.of_int (17))))) + (Prims.of_int (748)) (Prims.of_int (4)) + (Prims.of_int (748)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (750)) (Prims.of_int (4)) - (Prims.of_int (754)) (Prims.of_int (5))))) + (Prims.of_int (749)) (Prims.of_int (4)) + (Prims.of_int (753)) (Prims.of_int (5))))) (Obj.magic (apply (FStar_Reflection_V2_Builtins.pack_ln @@ -4235,14 +4235,14 @@ let add_elem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (751)) (Prims.of_int (14)) - (Prims.of_int (751)) (Prims.of_int (18))))) + (Prims.of_int (750)) (Prims.of_int (14)) + (Prims.of_int (750)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (752)) (Prims.of_int (6)) - (Prims.of_int (753)) (Prims.of_int (7))))) + (Prims.of_int (751)) (Prims.of_int (6)) + (Prims.of_int (752)) (Prims.of_int (7))))) (Obj.magic (t ())) (fun uu___3 -> (fun x -> @@ -4252,17 +4252,17 @@ let add_elem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (752)) + (Prims.of_int (751)) (Prims.of_int (6)) - (Prims.of_int (752)) + (Prims.of_int (751)) (Prims.of_int (12))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (751)) + (Prims.of_int (750)) (Prims.of_int (10)) - (Prims.of_int (751)) + (Prims.of_int (750)) (Prims.of_int (11))))) (Obj.magic (qed ())) (fun uu___3 -> @@ -4284,13 +4284,13 @@ let specialize : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (773)) (Prims.of_int (42)) - (Prims.of_int (773)) (Prims.of_int (51))))) + (Prims.of_int (772)) (Prims.of_int (42)) + (Prims.of_int (772)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (773)) (Prims.of_int (36)) - (Prims.of_int (773)) (Prims.of_int (51))))) + (Prims.of_int (772)) (Prims.of_int (36)) + (Prims.of_int (772)) (Prims.of_int (51))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> (fun uu___2 -> @@ -4310,12 +4310,12 @@ let (tlabel : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (776)) (Prims.of_int (10)) (Prims.of_int (776)) + (Prims.of_int (775)) (Prims.of_int (10)) (Prims.of_int (775)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (776)) (Prims.of_int (4)) (Prims.of_int (779)) + (Prims.of_int (775)) (Prims.of_int (4)) (Prims.of_int (778)) (Prims.of_int (38))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -4332,12 +4332,12 @@ let (tlabel' : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (782)) (Prims.of_int (10)) (Prims.of_int (782)) + (Prims.of_int (781)) (Prims.of_int (10)) (Prims.of_int (781)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (782)) (Prims.of_int (4)) (Prims.of_int (786)) + (Prims.of_int (781)) (Prims.of_int (4)) (Prims.of_int (785)) (Prims.of_int (26))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -4351,14 +4351,14 @@ let (tlabel' : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (785)) (Prims.of_int (16)) - (Prims.of_int (785)) (Prims.of_int (45))))) + (Prims.of_int (784)) (Prims.of_int (16)) + (Prims.of_int (784)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (786)) (Prims.of_int (8)) - (Prims.of_int (786)) (Prims.of_int (26))))) + (Prims.of_int (785)) (Prims.of_int (8)) + (Prims.of_int (785)) (Prims.of_int (26))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> FStar_Tactics_Types.set_label @@ -4375,37 +4375,37 @@ let (focus_all : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (789)) (Prims.of_int (4)) (Prims.of_int (789)) + (Prims.of_int (788)) (Prims.of_int (4)) (Prims.of_int (788)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (790)) (Prims.of_int (4)) (Prims.of_int (790)) + (Prims.of_int (789)) (Prims.of_int (4)) (Prims.of_int (789)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (789)) (Prims.of_int (14)) - (Prims.of_int (789)) (Prims.of_int (39))))) + (Prims.of_int (788)) (Prims.of_int (14)) + (Prims.of_int (788)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (789)) (Prims.of_int (4)) - (Prims.of_int (789)) (Prims.of_int (39))))) + (Prims.of_int (788)) (Prims.of_int (4)) + (Prims.of_int (788)) (Prims.of_int (39))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (789)) (Prims.of_int (15)) - (Prims.of_int (789)) (Prims.of_int (23))))) + (Prims.of_int (788)) (Prims.of_int (15)) + (Prims.of_int (788)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (789)) (Prims.of_int (14)) - (Prims.of_int (789)) (Prims.of_int (39))))) + (Prims.of_int (788)) (Prims.of_int (14)) + (Prims.of_int (788)) (Prims.of_int (39))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -4415,17 +4415,17 @@ let (focus_all : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (789)) + (Prims.of_int (788)) (Prims.of_int (26)) - (Prims.of_int (789)) + (Prims.of_int (788)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (789)) + (Prims.of_int (788)) (Prims.of_int (14)) - (Prims.of_int (789)) + (Prims.of_int (788)) (Prims.of_int (39))))) (Obj.magic (smt_goals ())) (fun uu___2 -> @@ -4461,25 +4461,25 @@ let (bump_nth : Prims.pos -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (805)) (Prims.of_int (8)) (Prims.of_int (805)) + (Prims.of_int (804)) (Prims.of_int (8)) (Prims.of_int (804)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (805)) (Prims.of_int (2)) (Prims.of_int (807)) + (Prims.of_int (804)) (Prims.of_int (2)) (Prims.of_int (806)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (805)) (Prims.of_int (28)) - (Prims.of_int (805)) (Prims.of_int (38))))) + (Prims.of_int (804)) (Prims.of_int (28)) + (Prims.of_int (804)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (805)) (Prims.of_int (8)) - (Prims.of_int (805)) (Prims.of_int (38))))) + (Prims.of_int (804)) (Prims.of_int (8)) + (Prims.of_int (804)) (Prims.of_int (38))))) (Obj.magic (goals ())) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac @@ -4503,12 +4503,12 @@ let rec (destruct_list : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (810)) (Prims.of_int (21)) (Prims.of_int (810)) + (Prims.of_int (809)) (Prims.of_int (21)) (Prims.of_int (809)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (809)) (Prims.of_int (52)) (Prims.of_int (822)) + (Prims.of_int (808)) (Prims.of_int (52)) (Prims.of_int (821)) (Prims.of_int (27))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_app t)) (fun uu___ -> @@ -4521,28 +4521,28 @@ let rec (destruct_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (811)) (Prims.of_int (10)) - (Prims.of_int (811)) (Prims.of_int (28))))) + (Prims.of_int (810)) (Prims.of_int (10)) + (Prims.of_int (810)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (811)) (Prims.of_int (4)) - (Prims.of_int (822)) (Prims.of_int (27))))) + (Prims.of_int (810)) (Prims.of_int (4)) + (Prims.of_int (821)) (Prims.of_int (27))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (811)) (Prims.of_int (10)) - (Prims.of_int (811)) (Prims.of_int (22))))) + (Prims.of_int (810)) (Prims.of_int (10)) + (Prims.of_int (810)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (811)) (Prims.of_int (10)) - (Prims.of_int (811)) (Prims.of_int (28))))) + (Prims.of_int (810)) (Prims.of_int (10)) + (Prims.of_int (810)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_NamedView.inspect head)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -4567,17 +4567,17 @@ let rec (destruct_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (815)) + (Prims.of_int (814)) (Prims.of_int (17)) - (Prims.of_int (815)) + (Prims.of_int (814)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (815)) + (Prims.of_int (814)) (Prims.of_int (11)) - (Prims.of_int (815)) + (Prims.of_int (814)) (Prims.of_int (33))))) (Obj.magic (destruct_list a2)) (fun uu___2 -> @@ -4605,17 +4605,17 @@ let rec (destruct_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (815)) + (Prims.of_int (814)) (Prims.of_int (17)) - (Prims.of_int (815)) + (Prims.of_int (814)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (815)) + (Prims.of_int (814)) (Prims.of_int (11)) - (Prims.of_int (815)) + (Prims.of_int (814)) (Prims.of_int (33))))) (Obj.magic (destruct_list a2)) (fun uu___3 -> @@ -4652,25 +4652,25 @@ let (get_match_body : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (825)) (Prims.of_int (8)) (Prims.of_int (825)) + (Prims.of_int (824)) (Prims.of_int (8)) (Prims.of_int (824)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (825)) (Prims.of_int (2)) (Prims.of_int (829)) + (Prims.of_int (824)) (Prims.of_int (2)) (Prims.of_int (828)) (Prims.of_int (46))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (825)) (Prims.of_int (22)) - (Prims.of_int (825)) (Prims.of_int (35))))) + (Prims.of_int (824)) (Prims.of_int (22)) + (Prims.of_int (824)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (825)) (Prims.of_int (8)) - (Prims.of_int (825)) (Prims.of_int (35))))) + (Prims.of_int (824)) (Prims.of_int (8)) + (Prims.of_int (824)) (Prims.of_int (35))))) (Obj.magic (cur_goal ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -4688,14 +4688,14 @@ let (get_match_body : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (827)) (Prims.of_int (20)) - (Prims.of_int (827)) (Prims.of_int (39))))) + (Prims.of_int (826)) (Prims.of_int (20)) + (Prims.of_int (826)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (827)) (Prims.of_int (14)) - (Prims.of_int (829)) (Prims.of_int (46))))) + (Prims.of_int (826)) (Prims.of_int (14)) + (Prims.of_int (828)) (Prims.of_int (46))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.inspect_unascribe t)) @@ -4724,13 +4724,13 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (842)) (Prims.of_int (14)) - (Prims.of_int (842)) (Prims.of_int (31))))) + (Prims.of_int (841)) (Prims.of_int (14)) + (Prims.of_int (841)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (842)) (Prims.of_int (34)) - (Prims.of_int (848)) (Prims.of_int (20))))) + (Prims.of_int (841)) (Prims.of_int (34)) + (Prims.of_int (847)) (Prims.of_int (20))))) (Obj.magic (get_match_body ())) (fun uu___2 -> (fun x -> @@ -4740,14 +4740,14 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (843)) (Prims.of_int (14)) - (Prims.of_int (843)) (Prims.of_int (26))))) + (Prims.of_int (842)) (Prims.of_int (14)) + (Prims.of_int (842)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (844)) (Prims.of_int (6)) - (Prims.of_int (848)) (Prims.of_int (20))))) + (Prims.of_int (843)) (Prims.of_int (6)) + (Prims.of_int (847)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V2_Builtins.t_destruct x)) (fun uu___2 -> (fun uu___2 -> @@ -4759,17 +4759,17 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (845)) + (Prims.of_int (844)) (Prims.of_int (17)) - (Prims.of_int (845)) + (Prims.of_int (844)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (845)) + (Prims.of_int (844)) (Prims.of_int (32)) - (Prims.of_int (848)) + (Prims.of_int (847)) (Prims.of_int (19))))) (Obj.magic (repeat @@ -4782,17 +4782,17 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (846)) + (Prims.of_int (845)) (Prims.of_int (16)) - (Prims.of_int (846)) + (Prims.of_int (845)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (847)) + (Prims.of_int (846)) (Prims.of_int (8)) - (Prims.of_int (848)) + (Prims.of_int (847)) (Prims.of_int (19))))) (Obj.magic (last bs)) (fun uu___4 -> @@ -4803,17 +4803,17 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (847)) + (Prims.of_int (846)) (Prims.of_int (8)) - (Prims.of_int (847)) + (Prims.of_int (846)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (848)) + (Prims.of_int (847)) (Prims.of_int (8)) - (Prims.of_int (848)) + (Prims.of_int (847)) (Prims.of_int (19))))) (Obj.magic (grewrite_eq b)) @@ -4835,12 +4835,12 @@ let (nth_var : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (857)) (Prims.of_int (11)) (Prims.of_int (857)) + (Prims.of_int (856)) (Prims.of_int (11)) (Prims.of_int (856)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (857)) (Prims.of_int (25)) (Prims.of_int (862)) + (Prims.of_int (856)) (Prims.of_int (25)) (Prims.of_int (861)) (Prims.of_int (15))))) (Obj.magic (cur_vars ())) (fun uu___ -> (fun bs -> @@ -4849,13 +4849,13 @@ let (nth_var : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (858)) (Prims.of_int (16)) - (Prims.of_int (858)) (Prims.of_int (65))))) + (Prims.of_int (857)) (Prims.of_int (16)) + (Prims.of_int (857)) (Prims.of_int (65))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (858)) (Prims.of_int (68)) - (Prims.of_int (862)) (Prims.of_int (15))))) + (Prims.of_int (857)) (Prims.of_int (68)) + (Prims.of_int (861)) (Prims.of_int (15))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> if i >= Prims.int_zero @@ -4869,14 +4869,14 @@ let (nth_var : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (859)) (Prims.of_int (16)) - (Prims.of_int (859)) (Prims.of_int (62))))) + (Prims.of_int (858)) (Prims.of_int (16)) + (Prims.of_int (858)) (Prims.of_int (62))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (860)) (Prims.of_int (2)) - (Prims.of_int (862)) (Prims.of_int (15))))) + (Prims.of_int (859)) (Prims.of_int (2)) + (Prims.of_int (861)) (Prims.of_int (15))))) (if k < Prims.int_zero then fail "not enough binders" else @@ -4903,12 +4903,12 @@ let (name_appears_in : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (870)) (Prims.of_int (4)) (Prims.of_int (875)) + (Prims.of_int (869)) (Prims.of_int (4)) (Prims.of_int (874)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (877)) (Prims.of_int (2)) (Prims.of_int (879)) + (Prims.of_int (876)) (Prims.of_int (2)) (Prims.of_int (878)) (Prims.of_int (16))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> @@ -4917,13 +4917,13 @@ let (name_appears_in : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (870)) (Prims.of_int (10)) - (Prims.of_int (870)) (Prims.of_int (19))))) + (Prims.of_int (869)) (Prims.of_int (10)) + (Prims.of_int (869)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (870)) (Prims.of_int (4)) - (Prims.of_int (875)) (Prims.of_int (19))))) + (Prims.of_int (869)) (Prims.of_int (4)) + (Prims.of_int (874)) (Prims.of_int (19))))) (Obj.magic (FStar_Tactics_NamedView.inspect t1)) (fun uu___1 -> (fun uu___1 -> @@ -4936,17 +4936,17 @@ let (name_appears_in : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (872)) + (Prims.of_int (871)) (Prims.of_int (6)) - (Prims.of_int (873)) + (Prims.of_int (872)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (869)) + (Prims.of_int (868)) (Prims.of_int (10)) - (Prims.of_int (869)) + (Prims.of_int (868)) (Prims.of_int (11))))) (if (FStar_Reflection_V2_Builtins.inspect_fv @@ -4978,31 +4978,31 @@ let (name_appears_in : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (877)) (Prims.of_int (6)) - (Prims.of_int (877)) (Prims.of_int (30))))) + (Prims.of_int (876)) (Prims.of_int (6)) + (Prims.of_int (876)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (877)) (Prims.of_int (32)) - (Prims.of_int (877)) (Prims.of_int (37))))) + (Prims.of_int (876)) (Prims.of_int (32)) + (Prims.of_int (876)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (877)) + (Prims.of_int (876)) (Prims.of_int (13)) - (Prims.of_int (877)) + (Prims.of_int (876)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (877)) + (Prims.of_int (876)) (Prims.of_int (6)) - (Prims.of_int (877)) + (Prims.of_int (876)) (Prims.of_int (30))))) (Obj.magic (FStar_Tactics_Visit.visit_tm ff t)) @@ -5043,8 +5043,8 @@ let rec (mk_abs : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (886)) (Prims.of_int (13)) - (Prims.of_int (886)) (Prims.of_int (27))))) + (Prims.of_int (885)) (Prims.of_int (13)) + (Prims.of_int (885)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "dummy" Prims.int_zero @@ -5066,12 +5066,12 @@ let (namedv_to_simple_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (891)) (Prims.of_int (11)) (Prims.of_int (891)) + (Prims.of_int (890)) (Prims.of_int (11)) (Prims.of_int (890)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (893)) (Prims.of_int (4)) (Prims.of_int (897)) + (Prims.of_int (892)) (Prims.of_int (4)) (Prims.of_int (896)) (Prims.of_int (16))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Tactics_NamedView.inspect_namedv n)) @@ -5082,13 +5082,13 @@ let (namedv_to_simple_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (895)) (Prims.of_int (13)) - (Prims.of_int (895)) (Prims.of_int (27))))) + (Prims.of_int (894)) (Prims.of_int (13)) + (Prims.of_int (894)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (893)) (Prims.of_int (4)) - (Prims.of_int (897)) (Prims.of_int (16))))) + (Prims.of_int (892)) (Prims.of_int (4)) + (Prims.of_int (896)) (Prims.of_int (16))))) (Obj.magic (FStar_Tactics_Unseal.unseal nv.FStar_Reflection_V2_Data.sort)) @@ -5128,13 +5128,13 @@ let (string_to_term_with_lb : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (917)) (Prims.of_int (6)) - (Prims.of_int (920)) (Prims.of_int (27))))) + (Prims.of_int (916)) (Prims.of_int (6)) + (Prims.of_int (919)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (916)) (Prims.of_int (3)) - (Prims.of_int (924)) (Prims.of_int (21))))) + (Prims.of_int (915)) (Prims.of_int (3)) + (Prims.of_int (923)) (Prims.of_int (21))))) (Obj.magic (FStar_Tactics_Util.fold_left (fun uu___ -> @@ -5146,14 +5146,14 @@ let (string_to_term_with_lb : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (918)) (Prims.of_int (19)) - (Prims.of_int (918)) (Prims.of_int (36))))) + (Prims.of_int (917)) (Prims.of_int (19)) + (Prims.of_int (917)) (Prims.of_int (36))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (917)) (Prims.of_int (42)) - (Prims.of_int (919)) (Prims.of_int (25))))) + (Prims.of_int (916)) (Prims.of_int (42)) + (Prims.of_int (918)) (Prims.of_int (25))))) (Obj.magic (FStar_Tactics_V2_Builtins.push_bv_dsenv e1 i)) (fun uu___2 -> @@ -5172,14 +5172,14 @@ let (string_to_term_with_lb : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (920)) (Prims.of_int (30)) - (Prims.of_int (924)) (Prims.of_int (21))))) + (Prims.of_int (919)) (Prims.of_int (30)) + (Prims.of_int (923)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (920)) (Prims.of_int (30)) - (Prims.of_int (924)) (Prims.of_int (21))))) + (Prims.of_int (919)) (Prims.of_int (30)) + (Prims.of_int (923)) (Prims.of_int (21))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> uu___)) (fun uu___1 -> @@ -5190,17 +5190,17 @@ let (string_to_term_with_lb : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (921)) + (Prims.of_int (920)) (Prims.of_int (12)) - (Prims.of_int (921)) + (Prims.of_int (920)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (922)) + (Prims.of_int (921)) (Prims.of_int (4)) - (Prims.of_int (924)) + (Prims.of_int (923)) (Prims.of_int (21))))) (Obj.magic (FStar_Tactics_V2_Builtins.string_to_term @@ -5242,12 +5242,12 @@ let (smt_sync : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (936)) (Prims.of_int (40)) (Prims.of_int (936)) + (Prims.of_int (935)) (Prims.of_int (40)) (Prims.of_int (935)) (Prims.of_int (56))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (936)) (Prims.of_int (29)) (Prims.of_int (936)) + (Prims.of_int (935)) (Prims.of_int (29)) (Prims.of_int (935)) (Prims.of_int (56))))) (Obj.magic (FStar_Tactics_V2_Builtins.get_vconfig ())) (fun uu___1 -> @@ -5261,13 +5261,13 @@ let (smt_sync' : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (940)) (Prims.of_int (15)) - (Prims.of_int (940)) (Prims.of_int (29))))) + (Prims.of_int (939)) (Prims.of_int (15)) + (Prims.of_int (939)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (940)) (Prims.of_int (32)) - (Prims.of_int (944)) (Prims.of_int (20))))) + (Prims.of_int (939)) (Prims.of_int (32)) + (Prims.of_int (943)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V2_Builtins.get_vconfig ())) (fun uu___ -> (fun vcfg -> @@ -5276,13 +5276,13 @@ let (smt_sync' : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (941)) (Prims.of_int (18)) - (Prims.of_int (942)) (Prims.of_int (68))))) + (Prims.of_int (940)) (Prims.of_int (18)) + (Prims.of_int (941)) (Prims.of_int (68))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (944)) (Prims.of_int (4)) - (Prims.of_int (944)) (Prims.of_int (20))))) + (Prims.of_int (943)) (Prims.of_int (4)) + (Prims.of_int (943)) (Prims.of_int (20))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> { diff --git a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml index 955e3dfcd93..b7575c957ff 100644 --- a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml +++ b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml @@ -1,4 +1,6 @@ open Prims +let (dbg_attrs : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "attrs" type antiquotations_temp = (FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.term) Prims.list let (tun_r : FStar_Compiler_Range_Type.range -> FStar_Syntax_Syntax.term) = @@ -7502,8 +7504,8 @@ let rec (desugar_tycon : (match uu___11 with | (constrNames, constrs1) -> ((let uu___13 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "attrs") in + FStar_Compiler_Effect.op_Bang + dbg_attrs in if uu___13 then let uu___14 = @@ -7592,8 +7594,7 @@ let rec (desugar_tycon : (match uu___3 with | (bundle, abbrevs) -> ((let uu___5 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "attrs") in + FStar_Compiler_Effect.op_Bang dbg_attrs in if uu___5 then let uu___6 = @@ -9006,9 +9007,7 @@ and (desugar_decl_core : desugar_tycon env d d_attrs uu___1 tcs in (match uu___ with | (env1, ses) -> - ((let uu___2 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "attrs") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_attrs in if uu___2 then let uu___3 = FStar_Parser_AST.decl_to_string d in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Cfg.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Cfg.ml index caf64d7bfe2..a93274b1be0 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Cfg.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Cfg.ml @@ -2245,8 +2245,13 @@ let (log_cfg : cfg -> (unit -> unit) -> unit) = fun cfg1 -> fun f -> if (cfg1.debug).cfg then f () else () let (log_primops : cfg -> (unit -> unit) -> unit) = fun cfg1 -> fun f -> if (cfg1.debug).primop then f () else () +let (dbg_unfolding : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Unfolding" let (log_unfolding : cfg -> (unit -> unit) -> unit) = - fun cfg1 -> fun f -> if (cfg1.debug).unfolding then f () else () + fun cfg1 -> + fun f -> + let uu___ = FStar_Compiler_Effect.op_Bang dbg_unfolding in + if uu___ then f () else () let (log_nbe : cfg -> (unit -> unit) -> unit) = fun cfg1 -> fun f -> if (cfg1.debug).debug_nbe then f () else () let (primop_time_map : Prims.int FStar_Compiler_Util.smap) = @@ -2385,6 +2390,28 @@ let (add_nbe : fsteps -> fsteps) = default_univs_to_zero = (s.default_univs_to_zero) } else s +let (dbg_Norm : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Norm" +let (dbg_NormTop : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "NormTop" +let (dbg_NormCfg : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "NormCfg" +let (dbg_Primops : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Primops" +let (dbg_Unfolding : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Unfolding" +let (dbg_380 : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "380" +let (dbg_WPE : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "WPE" +let (dbg_NormDelayed : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "NormDelayed" +let (dbg_print_normalized : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "print_normalized_terms" +let (dbg_NBE : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "NBE" +let (dbg_UNSOUND_EraseErasableArgs : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "UNSOUND_EraseErasableArgs" let (config' : FStar_TypeChecker_Primops_Base.primitive_step Prims.list -> FStar_TypeChecker_Env.step Prims.list -> FStar_TypeChecker_Env.env -> cfg) @@ -2418,59 +2445,41 @@ let (config' : let dbg_flag = FStar_Compiler_List.contains FStar_TypeChecker_Env.NormDebug s in let uu___ = - let uu___1 = dbg_flag || (FStar_Options.debug_any ()) in - if uu___1 - then - let uu___2 = - (FStar_TypeChecker_Env.debug e (FStar_Options.Other "Norm")) || - dbg_flag in - let uu___3 = - (FStar_TypeChecker_Env.debug e (FStar_Options.Other "NormTop")) - || dbg_flag in - let uu___4 = - FStar_TypeChecker_Env.debug e (FStar_Options.Other "NormCfg") in - let uu___5 = - FStar_TypeChecker_Env.debug e (FStar_Options.Other "Primops") in - let uu___6 = - FStar_TypeChecker_Env.debug e (FStar_Options.Other "Unfolding") in - let uu___7 = - FStar_TypeChecker_Env.debug e (FStar_Options.Other "380") in - let uu___8 = - FStar_TypeChecker_Env.debug e (FStar_Options.Other "WPE") in - let uu___9 = - FStar_TypeChecker_Env.debug e - (FStar_Options.Other "NormDelayed") in - let uu___10 = - FStar_TypeChecker_Env.debug e - (FStar_Options.Other "print_normalized_terms") in - let uu___11 = - FStar_TypeChecker_Env.debug e (FStar_Options.Other "NBE") in - let uu___12 = - let b = - FStar_TypeChecker_Env.debug e - (FStar_Options.Other "UNSOUND_EraseErasableArgs") in - if b - then - (let uu___14 = FStar_TypeChecker_Env.get_range e in - FStar_Errors.log_issue uu___14 - (FStar_Errors_Codes.Warning_WarnOnUse, - "The 'UNSOUND_EraseErasableArgs' setting is for debugging only; it is not sound")) - else (); - b in - { - gen = uu___2; - top = uu___3; - cfg = uu___4; - primop = uu___5; - unfolding = uu___6; - b380 = uu___7; - wpe = uu___8; - norm_delayed = uu___9; - print_normalized = uu___10; - debug_nbe = uu___11; - erase_erasable_args = uu___12 - } - else no_debug_switches in + let uu___1 = (FStar_Compiler_Effect.op_Bang dbg_Norm) || dbg_flag in + let uu___2 = + (FStar_Compiler_Effect.op_Bang dbg_NormTop) || dbg_flag in + let uu___3 = FStar_Compiler_Effect.op_Bang dbg_NormCfg in + let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Primops in + let uu___5 = FStar_Compiler_Effect.op_Bang dbg_Unfolding in + let uu___6 = FStar_Compiler_Effect.op_Bang dbg_380 in + let uu___7 = FStar_Compiler_Effect.op_Bang dbg_WPE in + let uu___8 = FStar_Compiler_Effect.op_Bang dbg_NormDelayed in + let uu___9 = FStar_Compiler_Effect.op_Bang dbg_print_normalized in + let uu___10 = FStar_Compiler_Effect.op_Bang dbg_NBE in + let uu___11 = + (let uu___13 = + FStar_Compiler_Effect.op_Bang dbg_UNSOUND_EraseErasableArgs in + if uu___13 + then + let uu___14 = FStar_TypeChecker_Env.get_range e in + FStar_Errors.log_issue uu___14 + (FStar_Errors_Codes.Warning_WarnOnUse, + "The 'UNSOUND_EraseErasableArgs' setting is for debugging only; it is not sound") + else ()); + FStar_Compiler_Effect.op_Bang dbg_UNSOUND_EraseErasableArgs in + { + gen = uu___1; + top = uu___2; + cfg = uu___3; + primop = uu___4; + unfolding = uu___5; + b380 = uu___6; + wpe = uu___7; + norm_delayed = uu___8; + print_normalized = uu___9; + debug_nbe = uu___10; + erase_erasable_args = uu___11 + } in let uu___1 = (Prims.op_Negation steps.pure_subterms_within_computations) || (FStar_Options.normalize_pure_terms_for_extraction ()) in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml index ec893d12455..ab1f0ea99e5 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml @@ -6,6 +6,14 @@ let (uu___is_E_Total : tot_or_ghost -> Prims.bool) = fun projectee -> match projectee with | E_Total -> true | uu___ -> false let (uu___is_E_Ghost : tot_or_ghost -> Prims.bool) = fun projectee -> match projectee with | E_Ghost -> true | uu___ -> false +let (dbg : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Core" +let (dbg_Eq : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "CoreEq" +let (dbg_Top : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "CoreTop" +let (dbg_Exit : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "CoreExit" let (goal_ctr : Prims.int FStar_Compiler_Effect.ref) = FStar_Compiler_Util.mk_ref Prims.int_zero let (get_goal_ctr : unit -> Prims.int) = @@ -1597,11 +1605,10 @@ let (guard_not_allowed : Prims.bool result) = fun ctx -> Success ((ctx.no_guard), FStar_Pervasives_Native.None) let (unfolding_ok : Prims.bool result) = fun ctx -> Success ((ctx.unfolding_ok), FStar_Pervasives_Native.None) -let (debug : env -> (unit -> unit) -> unit) = +let debug : 'uuuuu . 'uuuuu -> (unit -> unit) -> unit = fun g -> fun f -> - let uu___ = - FStar_TypeChecker_Env.debug g.tcenv (FStar_Options.Other "Core") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg in if uu___ then f () else () let (showable_side : side FStar_Class_Show.showable) = { @@ -1701,8 +1708,7 @@ let rec (check_relation : fail uu___2 in let rel_to_string rel1 = match rel1 with | EQUALITY -> "=?=" | SUBTYPING uu___ -> "<:?" in - (let uu___1 = - FStar_TypeChecker_Env.debug g.tcenv (FStar_Options.Other "Core") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg in if uu___1 then let uu___2 = FStar_Syntax_Print.tag_of_term t0 in @@ -2224,10 +2230,8 @@ let rec (check_relation : match x2 with | FStar_Pervasives_Native.None -> ((let uu___13 = - FStar_TypeChecker_Env.debug - g.tcenv - (FStar_Options.Other - "Core") in + FStar_Compiler_Effect.op_Bang + dbg in if uu___13 then let uu___14 = @@ -7754,8 +7758,7 @@ let (check_term_top_gh : fun topt -> fun must_tot -> fun gh -> - (let uu___1 = - FStar_TypeChecker_Env.debug g (FStar_Options.Other "CoreEq") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Eq in if uu___1 then let uu___2 = @@ -7764,10 +7767,8 @@ let (check_term_top_gh : FStar_Compiler_Util.print1 "(%s) Entering core ... \n" uu___2 else ()); (let uu___2 = - (FStar_TypeChecker_Env.debug g (FStar_Options.Other "Core")) - || - (FStar_TypeChecker_Env.debug g - (FStar_Options.Other "CoreTop")) in + (FStar_Compiler_Effect.op_Bang dbg) || + (FStar_Compiler_Effect.op_Bang dbg_Top) in if uu___2 then let uu___3 = @@ -7807,14 +7808,9 @@ let (check_term_top_gh : FStar_TypeChecker_Normalize.normalize simplify_steps g guard0 in ((let uu___5 = - ((FStar_TypeChecker_Env.debug g - (FStar_Options.Other "CoreExit")) - || - (FStar_TypeChecker_Env.debug g - (FStar_Options.Other "Core"))) - || - (FStar_TypeChecker_Env.debug g - (FStar_Options.Other "CoreTop")) in + ((FStar_Compiler_Effect.op_Bang dbg) || + (FStar_Compiler_Effect.op_Bang dbg_Top)) + || (FStar_Compiler_Effect.op_Bang dbg_Exit) in if uu___5 then ((let uu___7 = @@ -7861,11 +7857,8 @@ let (check_term_top_gh : Success (et, (FStar_Pervasives_Native.Some guard1))) | Success uu___4 -> ((let uu___6 = - (FStar_TypeChecker_Env.debug g - (FStar_Options.Other "Core")) - || - (FStar_TypeChecker_Env.debug g - (FStar_Options.Other "CoreTop")) in + (FStar_Compiler_Effect.op_Bang dbg) || + (FStar_Compiler_Effect.op_Bang dbg_Top) in if uu___6 then let uu___7 = @@ -7877,11 +7870,8 @@ let (check_term_top_gh : res) | Error uu___4 -> ((let uu___6 = - (FStar_TypeChecker_Env.debug g - (FStar_Options.Other "Core")) - || - (FStar_TypeChecker_Env.debug g - (FStar_Options.Other "CoreTop")) in + (FStar_Compiler_Effect.op_Bang dbg) || + (FStar_Compiler_Effect.op_Bang dbg_Top) in if uu___6 then let uu___7 = @@ -7891,8 +7881,7 @@ let (check_term_top_gh : "(%s) Exiting core (failed)\n" uu___7 else ()); res) in - (let uu___5 = - FStar_TypeChecker_Env.debug g (FStar_Options.Other "CoreEq") in + (let uu___5 = FStar_Compiler_Effect.op_Bang dbg_Eq in if uu___5 then (FStar_Syntax_TermHashTable.print_stats table; @@ -8001,9 +7990,7 @@ let (check_term_equality : fun t0 -> fun t1 -> let g1 = initial_env g FStar_Pervasives_Native.None in - (let uu___1 = - FStar_TypeChecker_Env.debug g1.tcenv - (FStar_Options.Other "CoreTop") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Top in if uu___1 then let uu___2 = @@ -8030,9 +8017,7 @@ let (check_term_equality : } in let r = let uu___1 = check_relation g1 EQUALITY t0 t1 in uu___1 ctx in - (let uu___2 = - FStar_TypeChecker_Env.debug g1.tcenv - (FStar_Options.Other "CoreTop") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Top in if uu___2 then let uu___3 = diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml index 926fa890760..733fcd70fce 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml @@ -15,6 +15,8 @@ let (__proj__Mkenv__item__tc_const : env -> FStar_Const.sconst -> FStar_Syntax_Syntax.typ) = fun projectee -> match projectee with | { tcenv; subst; tc_const;_} -> tc_const +let (dbg : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ED" let (d : Prims.string -> unit) = fun s -> FStar_Compiler_Util.print1 "\027[01;36m%s\027[00m\n" s let (mk_toplevel_definition : @@ -26,8 +28,7 @@ let (mk_toplevel_definition : fun env1 -> fun lident -> fun def -> - (let uu___1 = - FStar_TypeChecker_Env.debug env1 (FStar_Options.Other "ED") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg in if uu___1 then ((let uu___3 = FStar_Ident.string_of_lid lident in d uu___3); @@ -101,8 +102,7 @@ let (gen_wps_for_free : FStar_Syntax_Syntax.sort = uu___ } in let d1 s = FStar_Compiler_Util.print1 "\027[01;36m%s\027[00m\n" s in - (let uu___1 = - FStar_TypeChecker_Env.debug env1 (FStar_Options.Other "ED") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg in if uu___1 then (d1 "Elaborating extra WP combinators"; @@ -148,8 +148,7 @@ let (gen_wps_for_free : let gamma = let uu___1 = collect_binders wp_a1 in FStar_Syntax_Util.name_binders uu___1 in - (let uu___2 = - FStar_TypeChecker_Env.debug env1 (FStar_Options.Other "ED") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg in if uu___2 then let uu___3 = @@ -1336,9 +1335,7 @@ let (gen_wps_for_free : let uu___3 = mk_lid "wp_trivial" in register env2 uu___3 wp_trivial in let wp_trivial2 = mk_generic_app wp_trivial1 in - ((let uu___4 = - FStar_TypeChecker_Env.debug env2 - (FStar_Options.Other "ED") in + ((let uu___4 = FStar_Compiler_Effect.op_Bang dbg in if uu___4 then d1 "End Dijkstra monads for free" else ()); (let c = FStar_Syntax_Subst.close binders in let ed_combs = @@ -3887,8 +3884,7 @@ let (recheck_debug : fun s -> fun env1 -> fun t -> - (let uu___1 = - FStar_TypeChecker_Env.debug env1 (FStar_Options.Other "ED") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg in if uu___1 then let uu___2 = FStar_Syntax_Print.term_to_string t in @@ -3898,8 +3894,7 @@ let (recheck_debug : (let uu___1 = FStar_TypeChecker_TcTerm.tc_term env1 t in match uu___1 with | (t', uu___2, uu___3) -> - ((let uu___5 = - FStar_TypeChecker_Env.debug env1 (FStar_Options.Other "ED") in + ((let uu___5 = FStar_Compiler_Effect.op_Bang dbg in if uu___5 then let uu___6 = FStar_Syntax_Print.term_to_string t' in @@ -4015,8 +4010,7 @@ let (cps_and_elaborate : (match uu___6 with | (repr, _comp) -> ((let uu___8 = - FStar_TypeChecker_Env.debug env2 - (FStar_Options.Other "ED") in + FStar_Compiler_Effect.op_Bang dbg in if uu___8 then let uu___9 = @@ -4456,7 +4450,8 @@ let (cps_and_elaborate : | FStar_Pervasives_Native.Some (_us, _t) -> ((let uu___16 = - FStar_Options.debug_any () in + FStar_Compiler_Debug.any + () in if uu___16 then let uu___17 = @@ -4695,10 +4690,8 @@ let (cps_and_elaborate : uu___20 in ((let uu___20 = - FStar_TypeChecker_Env.debug - env2 - (FStar_Options.Other - "ED") in + FStar_Compiler_Effect.op_Bang + dbg in if uu___20 then let uu___21 @@ -5146,10 +5139,8 @@ let (cps_and_elaborate : match uu___20 with | (sigelts', ed2) -> ((let uu___22 = - FStar_TypeChecker_Env.debug - env2 - (FStar_Options.Other - "ED") in + FStar_Compiler_Effect.op_Bang + dbg in if uu___22 then let uu___23 = diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml index c0f4329182e..ba48df9bef1 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml @@ -131,6 +131,10 @@ let (uu___is_DefaultUnivsToZero : step -> Prims.bool) = fun projectee -> match projectee with | DefaultUnivsToZero -> true | uu___ -> false type steps = step Prims.list +let (dbg_ImplicitTrace : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ImplicitTrace" +let (dbg_LayeredEffectsEqns : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "LayeredEffectsEqns" let rec (eq_step : step -> step -> Prims.bool) = fun s1 -> fun s2 -> @@ -2406,11 +2410,6 @@ let (incr_query_index : env -> env) = erase_erasable_args = (env1.erase_erasable_args); core_check = (env1.core_check) })) -let (debug : env -> FStar_Options.debug_level_t -> Prims.bool) = - fun env1 -> - fun l -> - let uu___ = FStar_Ident.string_of_lid env1.curmodule in - FStar_Options.debug_at_level uu___ l let (set_range : env -> FStar_Compiler_Range_Type.range -> env) = fun e -> fun r -> @@ -6896,7 +6895,7 @@ let (new_tac_implicit_var : FStar_TypeChecker_Common.imp_range = r } in (let uu___2 = - debug env1 (FStar_Options.Other "ImplicitTrace") in + FStar_Compiler_Effect.op_Bang dbg_ImplicitTrace in if uu___2 then let uu___3 = @@ -6986,8 +6985,8 @@ let (uvars_for_binders : (match uu___2 with | (t, l_ctx_uvars, g_t) -> ((let uu___4 = - debug env1 - (FStar_Options.Other "LayeredEffectsEqns") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsEqns in if uu___4 then FStar_Compiler_List.iter diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Generalize.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Generalize.ml index 7010485cd85..396e6494eab 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Generalize.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Generalize.ml @@ -1,4 +1,6 @@ open Prims +let (dbg_Gen : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Gen" let (showable_univ_var : FStar_Syntax_Syntax.universe_uvar FStar_Class_Show.showable) = { @@ -35,8 +37,7 @@ let (gen_univs : (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic uu___2) in - (let uu___3 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Gen") in + (let uu___3 = FStar_Compiler_Effect.op_Bang dbg_Gen in if uu___3 then let uu___4 = @@ -53,9 +54,7 @@ let (gen_univs : FStar_Compiler_List.map (fun u -> let u_name = FStar_Syntax_Syntax.new_univ_name r in - (let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Gen") in + (let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Gen in if uu___4 then let uu___5 = @@ -132,8 +131,7 @@ let (generalize_universes : (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set FStar_Syntax_Syntax.ord_ident)) (Obj.magic uu___1) in - (let uu___2 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Gen") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Gen in if uu___2 then let uu___3 = @@ -147,8 +145,7 @@ let (generalize_universes : uu___3 uu___4 else ()); (let univs = FStar_Syntax_Free.univs t in - (let uu___3 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Gen") in + (let uu___3 = FStar_Compiler_Effect.op_Bang dbg_Gen in if uu___3 then let uu___4 = @@ -159,8 +156,7 @@ let (generalize_universes : FStar_Compiler_Util.print1 "univs to gen : %s\n" uu___4 else ()); (let gen = gen_univs env univs in - (let uu___4 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Gen") in + (let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Gen in if uu___4 then let uu___5 = @@ -202,8 +198,7 @@ let (gen : then FStar_Pervasives_Native.None else (let norm c = - (let uu___3 = - FStar_TypeChecker_Env.debug env FStar_Options.Medium in + (let uu___3 = FStar_Compiler_Debug.medium () in if uu___3 then let uu___4 = @@ -217,8 +212,7 @@ let (gen : FStar_TypeChecker_Env.Exclude FStar_TypeChecker_Env.Zeta; FStar_TypeChecker_Env.NoFullNorm; FStar_TypeChecker_Env.DoNotUnfoldPureLets] env c in - (let uu___4 = - FStar_TypeChecker_Env.debug env FStar_Options.Medium in + (let uu___4 = FStar_Compiler_Debug.medium () in if uu___4 then let uu___5 = @@ -246,9 +240,7 @@ let (gen : let t = FStar_Syntax_Util.comp_result c1 in let univs = FStar_Syntax_Free.univs t in let uvt = FStar_Syntax_Free.uvars t in - ((let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Gen") in + ((let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Gen in if uu___4 then let uu___5 = @@ -289,9 +281,7 @@ let (gen : (Obj.magic univs2) (Obj.magic uu___5))) uu___6 uu___5) univs uu___4 in let uvs = gen_uvars uvt in - (let uu___5 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Gen") in + (let uu___5 = FStar_Compiler_Effect.op_Bang dbg_Gen in if uu___5 then let uu___6 = @@ -583,7 +573,7 @@ let (generalize' : fun env -> fun is_rec -> fun lecs -> - (let uu___2 = FStar_TypeChecker_Env.debug env FStar_Options.Low in + (let uu___2 = FStar_Compiler_Debug.low () in if uu___2 then let uu___3 = @@ -634,8 +624,7 @@ let (generalize' : (fun uu___3 -> match uu___3 with | (l, t, c) -> (l, [], t, c, [])) lecs | FStar_Pervasives_Native.Some luecs -> - ((let uu___4 = - FStar_TypeChecker_Env.debug env FStar_Options.Medium in + ((let uu___4 = FStar_Compiler_Debug.medium () in if uu___4 then FStar_Compiler_List.iter diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_NBE.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_NBE.ml index 809a89458e4..e238925816f 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_NBE.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_NBE.ml @@ -1,4 +1,8 @@ open Prims +let (dbg_NBE : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "NBE" +let (dbg_NBETop : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "NBETop" let (max : Prims.int -> Prims.int -> Prims.int) = fun a -> fun b -> if a > b then a else b let map_rev : 'a 'b . ('a -> 'b) -> 'a Prims.list -> 'b Prims.list = @@ -3357,9 +3361,8 @@ let (normalize : (cfg.FStar_TypeChecker_Cfg.compat_memo_ignore_cfg) } in (let uu___1 = - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "NBETop")) - || - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "NBE")) in + (FStar_Compiler_Effect.op_Bang dbg_NBETop) || + (FStar_Compiler_Effect.op_Bang dbg_NBE) in if uu___1 then let uu___2 = FStar_Syntax_Print.term_to_string e in @@ -3368,9 +3371,8 @@ let (normalize : (let cfg2 = new_config cfg1 in let r = let uu___1 = translate cfg2 [] e in readback cfg2 uu___1 in (let uu___2 = - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "NBETop")) - || - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "NBE")) in + (FStar_Compiler_Effect.op_Bang dbg_NBETop) || + (FStar_Compiler_Effect.op_Bang dbg_NBE) in if uu___2 then let uu___3 = FStar_Syntax_Print.term_to_string r in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml index 45c3aa2d80c..991f0058a09 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml @@ -1,4 +1,8 @@ open Prims +let (dbg_univ_norm : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "univ_norm" +let (dbg_NormRebuild : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "NormRebuild" let (maybe_debug : FStar_TypeChecker_Cfg.cfg -> FStar_Syntax_Syntax.term -> @@ -357,9 +361,7 @@ let (norm_universe : (match uu___1 with | Univ u3 -> ((let uu___3 = - FStar_TypeChecker_Env.debug - cfg.FStar_TypeChecker_Cfg.tcenv - (FStar_Options.Other "univ_norm") in + FStar_Compiler_Effect.op_Bang dbg_univ_norm in if uu___3 then let uu___4 = @@ -4509,9 +4511,7 @@ and (do_unfold_fv : match stack1 with | (UnivArgs (us', uu___2))::stack2 -> ((let uu___4 = - FStar_TypeChecker_Env.debug - cfg.FStar_TypeChecker_Cfg.tcenv - (FStar_Options.Other "univ_norm") in + FStar_Compiler_Effect.op_Bang dbg_univ_norm in if uu___4 then FStar_Compiler_List.iter @@ -7014,9 +7014,7 @@ and (rebuild : FStar_Compiler_Util.print4 ">>> %s\nRebuild %s with %s env elements and top of the stack %s\n" uu___3 uu___4 uu___5 uu___6); - (let uu___3 = - FStar_TypeChecker_Env.debug cfg.FStar_TypeChecker_Cfg.tcenv - (FStar_Options.Other "NormRebuild") in + (let uu___3 = FStar_Compiler_Effect.op_Bang dbg_NormRebuild in if uu___3 then let uu___4 = FStar_Syntax_Util.unbound_variables t in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_PatternUtils.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_PatternUtils.ml index 48f71b4ccac..6121f349b6e 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_PatternUtils.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_PatternUtils.ml @@ -2,6 +2,8 @@ open Prims type lcomp_with_binder = (FStar_Syntax_Syntax.bv FStar_Pervasives_Native.option * FStar_TypeChecker_Common.lcomp) +let (dbg_Patterns : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Patterns" let rec (elaborate_pat : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.pat -> FStar_Syntax_Syntax.pat) @@ -301,8 +303,7 @@ let (pat_as_exp : (match eopt with | FStar_Pervasives_Native.None -> ((let uu___1 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "Patterns") in + FStar_Compiler_Effect.op_Bang dbg_Patterns in if uu___1 then (if diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Positivity.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Positivity.ml index 797fe186c64..6fa6b94eefe 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Positivity.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Positivity.ml @@ -1,14 +1,11 @@ open Prims -let (string_of_lids : FStar_Ident.lident Prims.list -> Prims.string) = - fun lids -> - let uu___ = FStar_Compiler_List.map FStar_Ident.string_of_lid lids in - FStar_Compiler_String.concat ", " uu___ +let (dbg_Positivity : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Positivity" let (debug_positivity : FStar_TypeChecker_Env.env_t -> (unit -> Prims.string) -> unit) = fun env -> fun msg -> - let uu___ = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Positivity") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg_Positivity in if uu___ then let uu___1 = @@ -16,6 +13,10 @@ let (debug_positivity : Prims.strcat "Positivity::" uu___2 in FStar_Compiler_Util.print_string uu___1 else () +let (string_of_lids : FStar_Ident.lident Prims.list -> Prims.string) = + fun lids -> + let uu___ = FStar_Compiler_List.map FStar_Ident.string_of_lid lids in + FStar_Compiler_String.concat ", " uu___ let (normalize : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml index b0078c87d6e..012abcc3a63 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml @@ -45,6 +45,40 @@ let (__proj__Implicit_has_typing_guard__item___0 : (FStar_Syntax_Syntax.term * FStar_Syntax_Syntax.typ)) = fun projectee -> match projectee with | Implicit_has_typing_guard _0 -> _0 +let (dbg_Disch : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Disch" +let (dbg_Discharge : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Discharge" +let (dbg_EQ : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "EQ" +let (dbg_ExplainRel : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ExplainRel" +let (dbg_GenUniverses : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "GenUniverses" +let (dbg_ImplicitTrace : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ImplicitTrace" +let (dbg_Imps : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Imps" +let (dbg_LayeredEffectsApp : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "LayeredEffectsApp" +let (dbg_LayeredEffectsEqns : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "LayeredEffectsEqns" +let (dbg_Rel : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Rel" +let (dbg_RelBench : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "RelBench" +let (dbg_RelDelta : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "RelDelta" +let (dbg_RelTop : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "RelTop" +let (dbg_ResolveImplicitsHook : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ResolveImplicitsHook" +let (dbg_Simplification : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Simplification" +let (dbg_SMTQuery : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "SMTQuery" +let (dbg_Tac : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Tac" let (showable_implicit_checking_status : implicit_checking_status FStar_Class_Show.showable) = { @@ -231,8 +265,6 @@ let (__proj__Mkworklist__item__typeclass_variables : | { attempting; wl_deferred; wl_deferred_to_tac; ctr; defer_ok; smt_ok; umax_heuristic_ok; tcenv; wl_implicits; repr_subcomp_allowed; typeclass_variables;_} -> typeclass_variables -let (debug : worklist -> FStar_Options.debug_level_t -> Prims.bool) = - fun wl -> fun lvl -> FStar_TypeChecker_Env.debug wl.tcenv lvl let (as_deferred : (Prims.int * FStar_TypeChecker_Common.deferred_reason * lstring * FStar_TypeChecker_Common.prob) Prims.list -> @@ -311,7 +343,7 @@ let (new_uvar : FStar_TypeChecker_Common.imp_range = r } in (let uu___2 = - debug wl (FStar_Options.Other "ImplicitTrace") in + FStar_Compiler_Effect.op_Bang dbg_ImplicitTrace in if uu___2 then let uu___3 = @@ -1112,7 +1144,7 @@ let (giveup : fun wl -> fun reason -> fun prob -> - (let uu___1 = debug wl (FStar_Options.Other "Rel") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = FStar_Thunk.force reason in @@ -1583,8 +1615,8 @@ let (explain : fun d -> fun s -> let uu___ = - (debug wl (FStar_Options.Other "ExplainRel")) || - (debug wl (FStar_Options.Other "Rel")) in + (FStar_Compiler_Effect.op_Bang dbg_ExplainRel) || + (FStar_Compiler_Effect.op_Bang dbg_Rel) in if uu___ then let uu___1 = FStar_Compiler_Range_Ops.string_of_range (p_loc d) in @@ -2121,10 +2153,11 @@ let (flex_uvar_head : (match uu___1 with | FStar_Syntax_Syntax.Tm_uvar (u, uu___2) -> u | uu___2 -> FStar_Compiler_Effect.failwith "Not a flex-uvar") -let (ensure_no_uvar_subst : - FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.term -> - worklist -> (FStar_Syntax_Syntax.term * worklist)) +let ensure_no_uvar_subst : + 'uuuuu . + 'uuuuu -> + FStar_Syntax_Syntax.term -> + worklist -> (FStar_Syntax_Syntax.term * worklist) = fun env -> fun t0 -> @@ -2195,8 +2228,7 @@ let (ensure_no_uvar_subst : FStar_Syntax_Syntax.mk_Tm_app t_v args_sol t0.FStar_Syntax_Syntax.pos in ((let uu___6 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___6 then let uu___7 = @@ -2376,7 +2408,7 @@ let (solve_prob' : | FStar_Pervasives_Native.None -> FStar_Syntax_Util.t_true | FStar_Pervasives_Native.Some phi1 -> phi1 in let assign_solution xs uv phi1 = - (let uu___2 = debug wl (FStar_Options.Other "Rel") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___2 then let uu___3 = FStar_Compiler_Util.string_of_int (p_pid prob) in @@ -2475,7 +2507,7 @@ let (extend_universe_solution : fun pid -> fun sol -> fun wl -> - (let uu___1 = debug wl (FStar_Options.Other "Rel") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = FStar_Compiler_Util.string_of_int pid in @@ -2508,7 +2540,7 @@ let (solve_prob : def_check_prob "solve_prob.prob" prob; FStar_Compiler_Util.iter_opt logical_guard (def_check_term_scoped_in_prob "solve_prob.guard" prob); - (let uu___3 = debug wl (FStar_Options.Other "Rel") in + (let uu___3 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___3 then let uu___4 = FStar_Compiler_Util.string_of_int (p_pid prob) in @@ -2971,8 +3003,7 @@ let rec (head_matches : fun t2 -> let t11 = FStar_Syntax_Util.unmeta t1 in let t21 = FStar_Syntax_Util.unmeta t2 in - (let uu___1 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "RelDelta") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_RelDelta in if uu___1 then ((let uu___3 = @@ -3162,9 +3193,7 @@ let (head_matches_delta : let maybe_inline t = let head = let uu___ = unrefine env t in FStar_Syntax_Util.head_of uu___ in - (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelDelta") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_RelDelta in if uu___1 then let uu___2 = @@ -3189,8 +3218,7 @@ let (head_matches_delta : (match uu___2 with | FStar_Pervasives_Native.None -> ((let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelDelta") in + FStar_Compiler_Effect.op_Bang dbg_RelDelta in if uu___4 then let uu___5 = @@ -3232,8 +3260,7 @@ let (head_matches_delta : then FStar_Pervasives_Native.None else ((let uu___7 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelDelta") in + FStar_Compiler_Effect.op_Bang dbg_RelDelta in if uu___7 then let uu___8 = @@ -3274,9 +3301,7 @@ let (head_matches_delta : Prims.op_Negation uu___1 in let rec aux retry n_delta t11 t21 = let r = head_matches env t11 t21 in - (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelDelta") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_RelDelta in if uu___1 then let uu___2 = @@ -3398,9 +3423,7 @@ let (head_matches_delta : | MisMatch uu___1 -> fail n_delta r t11 t21 | uu___1 -> success n_delta r t11 t21) in let r = aux true Prims.int_zero t1 t2 in - (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelDelta") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_RelDelta in if uu___1 then let uu___2 = @@ -4171,7 +4194,7 @@ let (should_defer_flex_to_user_tac : worklist -> flex_t -> Prims.bool) = FStar_TypeChecker_DeferredImplicits.should_defer_uvar_to_user_tac wl.tcenv u in ((let uu___4 = - debug wl (FStar_Options.Other "ResolveImplicitsHook") in + FStar_Compiler_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___4 then let uu___5 = FStar_Syntax_Print.ctx_uvar_to_string_no_reason u in @@ -4410,8 +4433,7 @@ let (run_meta_arg_tac : FStar_TypeChecker_Env.core_check = (env.FStar_TypeChecker_Env.core_check) } in - ((let uu___1 = - FStar_TypeChecker_Env.debug env1 (FStar_Options.Other "Tac") in + ((let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___1 then let uu___2 = @@ -4434,9 +4456,7 @@ let (simplify_vc : fun full_norm_allowed -> fun env -> fun t -> - (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Simplification") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Simplification in if uu___1 then let uu___2 = @@ -4455,9 +4475,7 @@ let (simplify_vc : else FStar_TypeChecker_Env.NoFullNorm :: steps in let t' = norm_with_steps "FStar.TypeChecker.Rel.simplify_vc" steps1 env t in - (let uu___2 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Simplification") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Simplification in if uu___2 then let uu___3 = @@ -4566,8 +4584,6 @@ let (apply_substitutive_indexed_subcomp : fun wl -> fun subcomp_name -> fun r1 -> - let debug1 = - debug wl (FStar_Options.Other "LayeredEffectsApp") in let uu___ = let uu___1 = bs in match uu___1 with @@ -4753,19 +4769,22 @@ let (apply_substitutive_indexed_subcomp : FStar_TypeChecker_Env.uvars_for_binders env [b] ss (fun b1 -> - if debug1 + let uu___7 = + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsApp in + if uu___7 then - let uu___7 = + let uu___8 = FStar_Syntax_Print.binder_to_string b1 in - let uu___8 = + let uu___9 = FStar_Compiler_Range_Ops.string_of_range r1 in FStar_Compiler_Util.format3 "implicit var for additional binder %s in subcomp %s at %s" - uu___7 - subcomp_name uu___8 + subcomp_name + uu___9 else "apply_substitutive_indexed_subcomp") r1 in @@ -4869,8 +4888,6 @@ let (apply_ad_hoc_indexed_subcomp : fun wl -> fun subcomp_name -> fun r1 -> - let dbg = - debug wl (FStar_Options.Other "LayeredEffectsApp") in let stronger_t_shape_error s = let uu___ = FStar_Ident.string_of_lid @@ -4912,16 +4929,19 @@ let (apply_ad_hoc_indexed_subcomp : ((a_b.FStar_Syntax_Syntax.binder_bv), (ct2.FStar_Syntax_Syntax.result_typ))] (fun b -> - if dbg + let uu___2 = + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsApp in + if uu___2 then - let uu___2 = - FStar_Syntax_Print.binder_to_string b in let uu___3 = + FStar_Syntax_Print.binder_to_string b in + let uu___4 = FStar_Compiler_Range_Ops.string_of_range r1 in FStar_Compiler_Util.format3 "implicit for binder %s in subcomp %s at %s" - uu___2 subcomp_name uu___3 + uu___3 subcomp_name uu___4 else "apply_ad_hoc_indexed_subcomp") r1 in (match uu___1 with | (rest_bs_uvars, g_uvars) -> @@ -4979,9 +4999,8 @@ let (apply_ad_hoc_indexed_subcomp : match uu___4 with | (ps, wl2) -> ((let uu___6 = - debug wl2 - (FStar_Options.Other - "LayeredEffectsEqns") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsApp in if uu___6 then let uu___7 = @@ -5036,9 +5055,8 @@ let (apply_ad_hoc_indexed_subcomp : match uu___5 with | (ps, wl3) -> ((let uu___7 = - debug wl3 - (FStar_Options.Other - "LayeredEffectsEqns") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsApp in if uu___7 then let uu___8 = @@ -5156,13 +5174,13 @@ let (__proj__Reveal__item___0 : = fun projectee -> match projectee with | Reveal _0 -> _0 let rec (solve : worklist -> solution) = fun probs -> - (let uu___1 = debug probs (FStar_Options.Other "Rel") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = wl_to_string probs in FStar_Compiler_Util.print1 "solve:\n\t%s\n" uu___2 else ()); - (let uu___2 = debug probs (FStar_Options.Other "ImplicitTrace") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_ImplicitTrace in if uu___2 then let uu___3 = @@ -5372,7 +5390,7 @@ and (giveup_or_defer : fun msg -> if wl.defer_ok = DeferAny then - ((let uu___1 = debug wl (FStar_Options.Other "Rel") in + ((let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = prob_to_string wl.tcenv orig in @@ -5393,7 +5411,7 @@ and (giveup_or_defer_flex_flex : fun msg -> if wl.defer_ok <> NoDefer then - ((let uu___1 = debug wl (FStar_Options.Other "Rel") in + ((let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = prob_to_string wl.tcenv orig in @@ -5408,7 +5426,7 @@ and (defer_to_user_tac : fun orig -> fun reason -> fun wl -> - (let uu___1 = debug wl (FStar_Options.Other "Rel") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = prob_to_string wl.tcenv orig in @@ -5503,7 +5521,7 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : (FStar_TypeChecker_Common.TProb p); ((FStar_TypeChecker_Common.TProb p), wl3)) in let pairwise t1 t2 wl2 = - (let uu___2 = debug wl2 (FStar_Options.Other "Rel") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___2 then let uu___3 = @@ -5770,7 +5788,7 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : (match uu___4 with | (t12, ps, wl3) -> ((let uu___6 = - debug wl3 (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___6 then let uu___7 = @@ -5829,7 +5847,7 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : | FStar_Pervasives_Native.Some (flex_bs, flex_t1) -> ((let uu___7 = - debug wl1 (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___7 then let uu___8 = @@ -5874,7 +5892,7 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : }] wl in solve uu___5) | uu___3 -> - ((let uu___5 = debug wl (FStar_Options.Other "Rel") in + ((let uu___5 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___5 then let uu___6 = @@ -6030,9 +6048,8 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : (FStar_TypeChecker_Common.TProb eq_prob); (let uu___13 = - debug wl1 - (FStar_Options.Other - "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___13 then let wl'1 = @@ -6163,9 +6180,8 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : solve wl4) | Failed (p, msg) -> ((let uu___16 = - debug wl1 - (FStar_Options.Other - "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___16 then let uu___17 = @@ -6551,7 +6567,7 @@ and (solve_binders : fun orig -> fun wl -> fun rhs -> - (let uu___1 = debug wl (FStar_Options.Other "Rel") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = FStar_Syntax_Print.binders_to_string ", " bs1 in @@ -6580,7 +6596,7 @@ and (solve_binders : let uu___1 = rhs wl1 scope subst in (match uu___1 with | (rhs_prob, wl2) -> - ((let uu___3 = debug wl2 (FStar_Options.Other "Rel") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___3 then let uu___4 = @@ -6687,8 +6703,8 @@ and (solve_binders : FStar_Syntax_Util.mk_conj (p_guard prob) uu___5 in ((let uu___6 = - debug wl3 - (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___6 then let uu___7 = @@ -6821,7 +6837,7 @@ and (solve_t_flex_rigid_eq : fun wl -> fun lhs -> fun rhs -> - (let uu___1 = debug wl (FStar_Options.Other "Rel") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 then FStar_Compiler_Util.print_string "solve_t_flex_rigid_eq\n" else ()); @@ -6915,7 +6931,7 @@ and (solve_t_flex_rigid_eq : u_abs uu___7 uu___8 rhs2 in [TERM (ctx_u, sol)]) in let try_quasi_pattern orig1 env wl1 lhs1 rhs1 = - (let uu___4 = debug wl1 (FStar_Options.Other "Rel") in + (let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___4 then FStar_Compiler_Util.print_string "try_quasi_pattern\n" else ()); @@ -7176,7 +7192,7 @@ and (solve_t_flex_rigid_eq : attempt sub_probs uu___9 in solve uu___8)))) in let imitate orig1 env wl1 lhs1 rhs1 = - (let uu___4 = debug wl1 (FStar_Options.Other "Rel") in + (let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___4 then FStar_Compiler_Util.print_string "imitate\n" else ()); @@ -7229,7 +7245,7 @@ and (solve_t_flex_rigid_eq : msg))) in let try_first_order orig1 env wl1 lhs1 rhs1 = let inapplicable msg lstring_opt = - (let uu___4 = debug wl1 (FStar_Options.Other "Rel") in + (let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___4 then let extra_msg = @@ -7242,7 +7258,7 @@ and (solve_t_flex_rigid_eq : extra_msg else ()); FStar_Pervasives.Inl "first_order doesn't apply" in - (let uu___4 = debug wl1 (FStar_Options.Other "Rel") in + (let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___4 then let uu___5 = flex_t_to_string lhs1 in @@ -7576,9 +7592,8 @@ and (solve_t_flex_rigid_eq : uvars_head wl1 else ((let uu___18 = - debug wl1 - (FStar_Options.Other - "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___18 then let uu___19 = @@ -7665,7 +7680,7 @@ and (solve_t_flex_rigid_eq : (match uu___4 with | FStar_Pervasives_Native.Some lhs_binders -> ((let uu___6 = - debug wl (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___6 then FStar_Compiler_Util.print_string @@ -7790,7 +7805,7 @@ and (solve_t_flex_flex : let run_meta_arg_tac_and_try_again flex = let uv = flex_uvar flex in let t = run_meta_arg_tac env uv in - (let uu___1 = debug wl (FStar_Options.Other "Rel") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = @@ -8028,9 +8043,8 @@ and (solve_t_flex_flex : w uu___24 w.FStar_Syntax_Syntax.pos in ((let uu___25 = - debug wl1 - (FStar_Options.Other - "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___25 then let uu___26 = @@ -8157,7 +8171,7 @@ and (solve_t' : tprob -> worklist -> solution) = let rigid_heads_match need_unif torig wl1 t1 t2 = let orig = FStar_TypeChecker_Common.TProb torig in let env = p_env wl1 orig in - (let uu___2 = debug wl1 (FStar_Options.Other "Rel") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___2 then let uu___3 = @@ -8324,8 +8338,8 @@ and (solve_t' : tprob -> worklist -> solution) = match uu___9 with | (subprobs, wl3) -> ((let uu___11 = - debug wl3 - (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___11 then let uu___12 = @@ -8401,8 +8415,8 @@ and (solve_t' : tprob -> worklist -> solution) = match uu___9 with | (prob, reason) -> ((let uu___11 = - debug wl2 - (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___11 then let uu___12 = @@ -8456,9 +8470,8 @@ and (solve_t' : tprob -> worklist -> solution) = -> ((let uu___18 = - debug wl2 - (FStar_Options.Other - "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___18 then @@ -8529,9 +8542,8 @@ and (solve_t' : tprob -> worklist -> solution) = } in ((let uu___19 = - debug wl2 - (FStar_Options.Other - "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___19 then @@ -8655,7 +8667,7 @@ and (solve_t' : tprob -> worklist -> solution) = uu___7 in FStar_Syntax_Util.unrefine uu___6 in (let uu___7 = - debug wl3 (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___7 then let uu___8 = @@ -8674,7 +8686,7 @@ and (solve_t' : tprob -> worklist -> solution) = match uu___7 with | (pat_term2, pat_term_t, g_pat_term) -> ((let uu___9 = - debug wl3 (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___9 then let uu___10 = @@ -8790,7 +8802,7 @@ and (solve_t' : tprob -> worklist -> solution) = | FStar_Pervasives_Native.None -> FStar_Pervasives.Inr FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some (t1, t2) -> - ((let uu___2 = debug wl1 (FStar_Options.Other "Rel") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___2 then let uu___3 = @@ -8823,7 +8835,7 @@ and (solve_t' : tprob -> worklist -> solution) = Prims.op_Negation uu___10 in if uu___9 then - ((let uu___11 = debug wl1 (FStar_Options.Other "Rel") in + ((let uu___11 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___11 then let uu___12 = @@ -8836,7 +8848,7 @@ and (solve_t' : tprob -> worklist -> solution) = else if wl1.defer_ok = DeferAny then - ((let uu___12 = debug wl1 (FStar_Options.Other "Rel") in + ((let uu___12 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___12 then FStar_Compiler_Util.print_string @@ -8844,7 +8856,7 @@ and (solve_t' : tprob -> worklist -> solution) = else ()); FStar_Pervasives.Inl "defer") else - ((let uu___13 = debug wl1 (FStar_Options.Other "Rel") in + ((let uu___13 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___13 then let uu___14 = @@ -8890,7 +8902,7 @@ and (solve_t' : tprob -> worklist -> solution) = match head_matching_branch with | FStar_Pervasives_Native.None -> ((let uu___14 = - debug wl1 (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___14 then FStar_Compiler_Util.print_string @@ -8921,7 +8933,7 @@ and (solve_t' : tprob -> worklist -> solution) = (match uu___13 with | (p, uu___14, e) -> ((let uu___16 = - debug wl1 (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___16 then let uu___17 = @@ -8953,7 +8965,7 @@ and (solve_t' : tprob -> worklist -> solution) = Prims.op_Negation uu___10 in if uu___9 then - ((let uu___11 = debug wl1 (FStar_Options.Other "Rel") in + ((let uu___11 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___11 then let uu___12 = @@ -8966,7 +8978,7 @@ and (solve_t' : tprob -> worklist -> solution) = else if wl1.defer_ok = DeferAny then - ((let uu___12 = debug wl1 (FStar_Options.Other "Rel") in + ((let uu___12 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___12 then FStar_Compiler_Util.print_string @@ -8974,7 +8986,7 @@ and (solve_t' : tprob -> worklist -> solution) = else ()); FStar_Pervasives.Inl "defer") else - ((let uu___13 = debug wl1 (FStar_Options.Other "Rel") in + ((let uu___13 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___13 then let uu___14 = @@ -9020,7 +9032,7 @@ and (solve_t' : tprob -> worklist -> solution) = match head_matching_branch with | FStar_Pervasives_Native.None -> ((let uu___14 = - debug wl1 (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___14 then FStar_Compiler_Util.print_string @@ -9051,7 +9063,7 @@ and (solve_t' : tprob -> worklist -> solution) = (match uu___13 with | (p, uu___14, e) -> ((let uu___16 = - debug wl1 (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___16 then let uu___17 = @@ -9067,7 +9079,7 @@ and (solve_t' : tprob -> worklist -> solution) = try_solve_branch scrutinee p in FStar_Pervasives.Inr uu___16))))) | uu___3 -> - ((let uu___5 = debug wl1 (FStar_Options.Other "Rel") in + ((let uu___5 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___5 then let uu___6 = FStar_Syntax_Print.tag_of_term t1 in @@ -9079,7 +9091,7 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_Pervasives.Inr FStar_Pervasives_Native.None))) in let rigid_rigid_delta torig wl1 head1 head2 t1 t2 = let orig = FStar_TypeChecker_Common.TProb torig in - (let uu___2 = debug wl1 (FStar_Options.Other "RelDelta") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_RelDelta in if uu___2 then let uu___3 = FStar_Syntax_Print.tag_of_term t1 in @@ -9369,7 +9381,7 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_Class_Binders.hasBinders_list_bv FStar_Class_Binders.hasNames_term FStar_Syntax_Print.pretty_term (p_loc orig) "ref.t2" uu___6 t2); - (let uu___7 = debug wl (FStar_Options.Other "Rel") in + (let uu___7 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___7 then let uu___8 = @@ -9669,7 +9681,7 @@ and (solve_t' : tprob -> worklist -> solution) = (match uu___9 with | (x22, phi21) -> ((let uu___11 = - debug wl (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___11 then ((let uu___13 = @@ -10558,9 +10570,8 @@ and (solve_t' : tprob -> worklist -> solution) = (match uu___21 with | (prob, wl3) -> ((let uu___23 = - debug wl3 - (FStar_Options.Other - "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___23 then let uu___24 = @@ -10666,7 +10677,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -10817,7 +10828,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -10968,7 +10979,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -11119,7 +11130,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -11270,7 +11281,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -11421,7 +11432,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -11572,7 +11583,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -11723,7 +11734,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -11874,7 +11885,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -12025,7 +12036,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -12176,7 +12187,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -12327,7 +12338,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -12576,7 +12587,7 @@ and (solve_c : mk_t_problem wl1 [] orig t1 rel t2 FStar_Pervasives_Native.None reason in let solve_eq c1_comp c2_comp g_lift = - (let uu___1 = debug wl (FStar_Options.Other "EQ") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_EQ in if uu___1 then let uu___2 = @@ -12744,7 +12755,7 @@ and (solve_c : Prims.op_Negation uu___1)) && (FStar_TypeChecker_Env.is_reifiable_effect wl.tcenv c22) in let solve_layered_sub c11 c21 = - (let uu___1 = debug wl (FStar_Options.Other "LayeredEffectsApp") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in if uu___1 then let uu___2 = @@ -12956,9 +12967,8 @@ and (solve_c : if uu___14 then ((let uu___16 = - debug wl2 - (FStar_Options.Other - "LayeredEffectsEqns") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsEqns in if uu___16 then let uu___17 = @@ -13038,9 +13048,8 @@ and (solve_c : (FStar_Pervasives_Native.Some guard) [] wl4 in ((let uu___12 = - debug wl5 - (FStar_Options.Other - "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsApp in if uu___12 then FStar_Compiler_Util.print_string @@ -13247,7 +13256,7 @@ and (solve_c : if is_null_wp_2 then ((let uu___10 = - debug wl (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then FStar_Compiler_Util.print_string @@ -13310,7 +13319,7 @@ and (solve_c : } in FStar_Syntax_Syntax.Tm_app uu___11 in FStar_Syntax_Syntax.mk uu___10 r)) in - (let uu___9 = debug wl (FStar_Options.Other "Rel") in + (let uu___9 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___9 then let uu___10 = @@ -13347,7 +13356,7 @@ and (solve_c : let uu___1 = solve_prob orig FStar_Pervasives_Native.None [] wl in solve uu___1 else - ((let uu___3 = debug wl (FStar_Options.Other "Rel") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___3 then let uu___4 = @@ -13599,7 +13608,7 @@ and (solve_c : FStar_TypeChecker_Env.unfold_effect_abbrev env c11 in let c22 = FStar_TypeChecker_Env.unfold_effect_abbrev env c21 in - (let uu___10 = debug wl (FStar_Options.Other "Rel") in + (let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -13693,10 +13702,8 @@ let (guard_to_string : | FStar_TypeChecker_Common.Trivial -> "trivial" | FStar_TypeChecker_Common.NonTrivial f -> let uu___1 = - ((FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Rel")) - || - (FStar_TypeChecker_Env.debug env FStar_Options.Extreme)) + ((FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Debug.extreme ())) || (FStar_Options.print_implicits ()) in if uu___1 then FStar_TypeChecker_Normalize.term_to_string env f @@ -13738,8 +13745,8 @@ let (new_t_problem : fun loc -> let reason = let uu___ = - (debug wl (FStar_Options.Other "ExplainRel")) || - (debug wl (FStar_Options.Other "Rel")) in + (FStar_Compiler_Effect.op_Bang dbg_ExplainRel) || + (FStar_Compiler_Effect.op_Bang dbg_Rel) in if uu___ then let uu___1 = @@ -13791,7 +13798,7 @@ let (solve_and_commit : fun wl -> fun err -> let tx = FStar_Syntax_Unionfind.new_transaction () in - (let uu___1 = debug wl (FStar_Options.Other "RelBench") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_RelBench in if uu___1 then let uu___2 = @@ -13803,7 +13810,7 @@ let (solve_and_commit : (let uu___1 = FStar_Compiler_Util.record_time (fun uu___2 -> solve wl) in match uu___1 with | (sol, ms) -> - ((let uu___3 = debug wl (FStar_Options.Other "RelBench") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_RelBench in if uu___3 then let uu___4 = FStar_Compiler_Util.string_of_int ms in @@ -13817,7 +13824,7 @@ let (solve_and_commit : (match uu___3 with | ((), ms1) -> ((let uu___5 = - debug wl (FStar_Options.Other "RelBench") in + FStar_Compiler_Effect.op_Bang dbg_RelBench in if uu___5 then let uu___6 = FStar_Compiler_Util.string_of_int ms1 in @@ -13828,8 +13835,8 @@ let (solve_and_commit : (deferred, defer_to_tac, implicits))) | Failed (d, s) -> ((let uu___4 = - (debug wl (FStar_Options.Other "ExplainRel")) || - (debug wl (FStar_Options.Other "Rel")) in + (FStar_Compiler_Effect.op_Bang dbg_ExplainRel) || + (FStar_Compiler_Effect.op_Bang dbg_Rel) in if uu___4 then let uu___5 = explain wl d s in @@ -13896,12 +13903,7 @@ let (try_teq : FStar_Pervasives_Native.Some uu___3 in FStar_Profiling.profile (fun uu___3 -> - (let uu___5 = - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Rel")) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelTop")) in + (let uu___5 = FStar_Compiler_Effect.op_Bang dbg_RelTop in if uu___5 then let uu___6 = @@ -13930,12 +13932,7 @@ let (try_teq : solve_and_commit (singleton wl prob smt_ok1) (fun uu___7 -> FStar_Pervasives_Native.None) in with_guard env prob uu___6 in - ((let uu___7 = - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Rel")) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelTop")) in + ((let uu___7 = FStar_Compiler_Effect.op_Bang dbg_RelTop in if uu___7 then let uu___8 = @@ -13963,10 +13960,8 @@ let (teq : FStar_TypeChecker_Common.trivial_guard) | FStar_Pervasives_Native.Some g -> ((let uu___2 = - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "Rel")) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelTop")) in + (FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Effect.op_Bang dbg_RelTop) in if uu___2 then let uu___3 = @@ -13989,8 +13984,8 @@ let (get_teq_predicate : fun t1 -> fun t2 -> (let uu___1 = - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "Rel")) || - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "RelTop")) in + (FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Effect.op_Bang dbg_RelTop) in if uu___1 then let uu___2 = @@ -14011,10 +14006,8 @@ let (get_teq_predicate : (fun uu___3 -> FStar_Pervasives_Native.None) in with_guard env prob uu___2 in ((let uu___3 = - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "Rel")) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelTop")) in + (FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Effect.op_Bang dbg_RelTop) in if uu___3 then let uu___4 = @@ -14066,11 +14059,8 @@ let (sub_or_eq_comp : then FStar_TypeChecker_Common.EQ else FStar_TypeChecker_Common.SUB in (let uu___3 = - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Rel")) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelTop")) in + (FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Effect.op_Bang dbg_RelTop) in if uu___3 then let uu___4 = @@ -14116,8 +14106,7 @@ let (sub_or_eq_comp : match uu___5 with | (r, ms) -> ((let uu___7 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelBench") in + FStar_Compiler_Effect.op_Bang dbg_RelBench in if uu___7 then let uu___8 = @@ -14303,8 +14292,7 @@ let (solve_universe_inequalities' : then true else ((let uu___7 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "GenUniverses") in + FStar_Compiler_Effect.op_Bang dbg_GenUniverses in if uu___7 then let uu___8 = @@ -14320,9 +14308,7 @@ let (solve_universe_inequalities' : if uu___2 then () else - ((let uu___5 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "GenUniverses") in + ((let uu___5 = FStar_Compiler_Effect.op_Bang dbg_GenUniverses in if uu___5 then ((let uu___7 = ineqs_to_string (variables, ineqs) in @@ -14437,9 +14423,7 @@ let (try_solve_deferred_constraints : FStar_Errors.raise_error (FStar_Errors_Codes.Fatal_ErrorInSolveDeferredConstraints, msg) (p_loc d) in - (let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Rel") in + (let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___4 then let uu___5 = FStar_Class_Show.show uu___78 defer_ok in @@ -14502,8 +14486,8 @@ let (try_solve_deferred_constraints : "FStar.TypeChecker.Rel.solve_deferred_to_tactic_goals" else g1 in (let uu___6 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "ResolveImplicitsHook") in + FStar_Compiler_Effect.op_Bang + dbg_ResolveImplicitsHook in if uu___6 then let uu___7 = guard_to_string env g2 in @@ -14569,17 +14553,14 @@ let (do_discharge_vc : fun use_env_range_msg -> fun env -> fun vc -> - let debug1 = - ((FStar_TypeChecker_Env.debug env (FStar_Options.Other "Rel")) || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "SMTQuery"))) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Discharge")) in + let debug = + ((FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Effect.op_Bang dbg_SMTQuery)) + || (FStar_Compiler_Effect.op_Bang dbg_Discharge) in let diag_doc = let uu___ = FStar_TypeChecker_Env.get_range env in FStar_Errors.diag_doc uu___ in - if debug1 + if debug then (let uu___1 = let uu___2 = @@ -14603,7 +14584,7 @@ let (do_discharge_vc : env vc in match uu___4 with | (did_anything, vcs1) -> - (if debug1 && did_anything + (if debug && did_anything then (let uu___6 = let uu___7 = @@ -14659,7 +14640,7 @@ let (do_discharge_vc : goal in (match uu___7 with | FStar_TypeChecker_Common.Trivial -> - (if debug1 + (if debug then (let uu___9 = let uu___10 = @@ -14705,7 +14686,7 @@ let (do_discharge_vc : FStar_Options.with_saved_options (fun uu___2 -> FStar_Options.set opts; - if debug1 + if debug then (let uu___5 = let uu___6 = @@ -14733,8 +14714,7 @@ let (discharge_guard' : fun g -> fun use_smt -> (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "ResolveImplicitsHook") in + FStar_Compiler_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___1 then let uu___2 = guard_to_string env g in @@ -14750,13 +14730,10 @@ let (discharge_guard' : let deferred_to_tac_ok = true in try_solve_deferred_constraints defer_ok smt_ok deferred_to_tac_ok env g in - let debug1 = - ((FStar_TypeChecker_Env.debug env (FStar_Options.Other "Rel")) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "SMTQuery"))) - || - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "Disch")) in + let debug = + ((FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Effect.op_Bang dbg_SMTQuery)) + || (FStar_Compiler_Effect.op_Bang dbg_Discharge) in let diag_doc = let uu___1 = FStar_TypeChecker_Env.get_range env in FStar_Errors.diag_doc uu___1 in @@ -14779,8 +14756,7 @@ let (discharge_guard' : if uu___1 then (if - debug1 && - (Prims.op_Negation env.FStar_TypeChecker_Env.phase1) + debug && (Prims.op_Negation env.FStar_TypeChecker_Env.phase1) then (let uu___3 = let uu___4 = @@ -14797,7 +14773,7 @@ let (discharge_guard' : FStar_Pervasives_Native.Some ret_g | FStar_TypeChecker_Common.NonTrivial vc when Prims.op_Negation use_smt -> - (if debug1 + (if debug then (let uu___4 = let uu___5 = @@ -14868,8 +14844,8 @@ let (subtype_nosmt : fun t1 -> fun t2 -> (let uu___1 = - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "Rel")) || - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "RelTop")) in + (FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Effect.op_Bang dbg_RelTop) in if uu___1 then let uu___2 = FStar_TypeChecker_Normalize.term_to_string env t1 in @@ -14914,10 +14890,8 @@ let (check_subtyping : FStar_Profiling.profile (fun uu___1 -> (let uu___3 = - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "Rel")) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelTop")) in + (FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Effect.op_Bang dbg_RelTop) in if uu___3 then let uu___4 = @@ -14942,11 +14916,8 @@ let (check_subtyping : (fun uu___5 -> FStar_Pervasives_Native.None) in with_guard env_x prob uu___4 in ((let uu___5 = - ((FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Rel")) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelTop"))) + ((FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Effect.op_Bang dbg_RelTop)) && (FStar_Compiler_Util.is_some g) in if uu___5 then @@ -15114,8 +15085,7 @@ let (check_implicit_solution_and_discharge_guard : let uvar_ty = FStar_Syntax_Util.ctx_uvar_typ imp_uvar in let uvar_should_check = FStar_Syntax_Util.ctx_uvar_should_check imp_uvar in - ((let uu___2 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Rel") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___2 then let uu___3 = @@ -15601,8 +15571,7 @@ let (resolve_implicits' : = uvar_decoration_should_check;_} -> ((let uu___5 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___5 then let uu___6 = @@ -15789,14 +15758,11 @@ let (resolve_implicits' : if defer_open_metas && is_open then ((let uu___7 = - (FStar_TypeChecker_Env.debug - env1 - (FStar_Options.Other "Rel")) + (FStar_Compiler_Effect.op_Bang + dbg_Rel) || - (FStar_TypeChecker_Env.debug - env1 - (FStar_Options.Other - "Imps")) in + (FStar_Compiler_Effect.op_Bang + dbg_Imps) in if uu___7 then let uu___8 = @@ -16105,9 +16071,7 @@ let (resolve_implicits : = fun env -> fun g -> - (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "ResolveImplicitsHook") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___1 then let uu___2 = guard_to_string env g in @@ -16118,9 +16082,7 @@ let (resolve_implicits : (let tagged_implicits1 = resolve_implicits' env false false g.FStar_TypeChecker_Common.implicits in - (let uu___2 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "ResolveImplicitsHook") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___2 then FStar_Compiler_Util.print_string @@ -16173,9 +16135,7 @@ let (force_trivial_guard : FStar_TypeChecker_Env.env -> FStar_TypeChecker_Common.guard_t -> unit) = fun env -> fun g -> - (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "ResolveImplicitsHook") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___1 then let uu___2 = guard_to_string env g in @@ -16265,9 +16225,7 @@ let (layered_effect_teq : fun t1 -> fun t2 -> fun reason -> - (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsEqns") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsEqns in if uu___1 then let uu___2 = diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml index b0c708e79e5..48516b8a16f 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml @@ -1,4 +1,14 @@ open Prims +let (dbg_TwoPhases : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "TwoPhases" +let (dbg_IdInfoOn : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "IdInfoOn" +let (dbg_Normalize : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Normalize" +let (dbg_UF : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "UF" +let (dbg_LogTypes : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "LogTypes" let (sigelt_typ : FStar_Syntax_Syntax.sigelt -> FStar_Syntax_Syntax.typ FStar_Pervasives_Native.option) @@ -382,7 +392,7 @@ let (tc_inductive' : fun quals -> fun attrs -> fun lids -> - (let uu___1 = FStar_TypeChecker_Env.debug env FStar_Options.Low in + (let uu___1 = FStar_Compiler_Debug.low () in if uu___1 then let uu___2 = @@ -977,8 +987,8 @@ let (tc_sig_let : FStar_TypeChecker_Env.preprocess env1 tau lb.FStar_Syntax_Syntax.lbdef in (let uu___4 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "TwoPhases") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang dbg_TwoPhases) in if uu___4 then let uu___5 = @@ -1368,8 +1378,9 @@ let (tc_sig_let : | (e3, uu___8, uu___9) -> e3) uu___5 "FStar.TypeChecker.Tc.tc_sig_let-tc-phase1" in (let uu___6 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "TwoPhases") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang + dbg_TwoPhases) in if uu___6 then let uu___7 = @@ -1384,8 +1395,9 @@ let (tc_sig_let : env' e2 in drop_lbtyp uu___6 in (let uu___7 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "TwoPhases") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang + dbg_TwoPhases) in if uu___7 then let uu___8 = @@ -2114,8 +2126,7 @@ let (tc_decl' : } else env in let env'1 = FStar_TypeChecker_Env.push env' "expect_failure" in - ((let uu___3 = - FStar_TypeChecker_Env.debug env FStar_Options.Low in + ((let uu___3 = FStar_Compiler_Debug.low () in if uu___3 then let uu___4 = @@ -2140,7 +2151,7 @@ let (tc_decl' : | (errs, uu___4) -> ((let uu___6 = (FStar_Options.print_expected_failures ()) || - (FStar_TypeChecker_Env.debug env FStar_Options.Low) in + (FStar_Compiler_Debug.low ()) in if uu___6 then (FStar_Compiler_Util.print_string @@ -2340,8 +2351,8 @@ let (tc_decl' : uu___5 in FStar_Syntax_Util.ses_of_sigbundle uu___4 in (let uu___5 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "TwoPhases") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang dbg_TwoPhases) in if uu___5 then let uu___6 = @@ -2648,8 +2659,8 @@ let (tc_decl' : uu___6 in FStar_Syntax_Util.eff_decl_of_new_effect uu___5 in (let uu___6 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "TwoPhases") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang dbg_TwoPhases) in if uu___6 then let uu___7 = @@ -3064,15 +3075,18 @@ let (tc_decl' : match uu___6 with | (uvs1, t1) -> ((let uu___8 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "TwoPhases") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang + dbg_TwoPhases) in if uu___8 then let uu___9 = - FStar_Syntax_Print.term_to_string t1 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t1 in let uu___10 = - FStar_Syntax_Print.univ_names_to_string - uvs1 in + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Ident.showable_ident) uvs1 in FStar_Compiler_Util.print2 "Val declaration after phase 1: %s and uvs: %s\n" uu___9 uu___10 @@ -3245,15 +3259,18 @@ let (tc_decl' : match uu___6 with | (uvs1, t1) -> ((let uu___8 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "TwoPhases") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang + dbg_TwoPhases) in if uu___8 then let uu___9 = - FStar_Syntax_Print.term_to_string t1 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t1 in let uu___10 = - FStar_Syntax_Print.univ_names_to_string - uvs1 in + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Ident.showable_ident) uvs1 in FStar_Compiler_Util.print2 "Assume after phase 1: %s and uvs: %s\n" uu___9 uu___10 @@ -3293,7 +3310,7 @@ let (tc_decl' : FStar_Syntax_Syntax.lids2 = lids; FStar_Syntax_Syntax.tac = t;_} -> - ((let uu___3 = FStar_Options.debug_any () in + ((let uu___3 = FStar_Compiler_Debug.any () in if uu___3 then let uu___4 = @@ -3511,8 +3528,7 @@ let (tc_decl' : FStar_TypeChecker_Env.core_check = (env.FStar_TypeChecker_Env.core_check) } in - (let uu___4 = - FStar_TypeChecker_Env.debug env1 FStar_Options.Low in + (let uu___4 = FStar_Compiler_Debug.low () in if uu___4 then let uu___5 = @@ -3712,8 +3728,9 @@ let (tc_decl' : match uu___6 with | (t2, ty) -> ((let uu___8 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "TwoPhases") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang + dbg_TwoPhases) in if uu___8 then let uu___9 = @@ -3954,8 +3971,9 @@ let (tc_decl' : match uu___6 with | (t2, ty) -> ((let uu___8 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "TwoPhases") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang + dbg_TwoPhases) in if uu___8 then let uu___9 = @@ -4030,23 +4048,13 @@ let (tc_decl : fun env -> fun se -> let env1 = set_hint_correlator env se in - (let uu___1 = - let uu___2 = - FStar_Ident.string_of_lid env1.FStar_TypeChecker_Env.curmodule in - FStar_Options.debug_module uu___2 in + (let uu___1 = FStar_Compiler_Debug.any () in if uu___1 then - let uu___2 = - let uu___3 = - let uu___4 = - FStar_Ident.string_of_lid env1.FStar_TypeChecker_Env.curmodule in - FStar_Options.debug_at_level uu___4 FStar_Options.High in - if uu___3 - then FStar_Syntax_Print.sigelt_to_string se - else FStar_Syntax_Print.sigelt_to_string_short se in + let uu___2 = FStar_Syntax_Print.sigelt_to_string_short se in FStar_Compiler_Util.print1 "Processing %s\n" uu___2 else ()); - (let uu___2 = FStar_TypeChecker_Env.debug env1 FStar_Options.Low in + (let uu___2 = FStar_Compiler_Debug.low () in if uu___2 then let uu___3 = @@ -4079,7 +4087,7 @@ let (add_sigelt_to_env : fun env -> fun se -> fun from_cache -> - (let uu___1 = FStar_TypeChecker_Env.debug env FStar_Options.Low in + (let uu___1 = FStar_Compiler_Debug.low () in if uu___1 then let uu___2 = @@ -4666,12 +4674,11 @@ let (tc_decls : (FStar_Pervasives_Native.Some (se.FStar_Syntax_Syntax.sigrng)); (let uu___2 = env1.FStar_TypeChecker_Env.nosynth && - (FStar_Options.debug_any ()) in + (FStar_Compiler_Debug.any ()) in if uu___2 then ((ses1, env1), []) else - ((let uu___5 = - FStar_TypeChecker_Env.debug env1 FStar_Options.Low in + ((let uu___5 = FStar_Compiler_Debug.low () in if uu___5 then let uu___6 = FStar_Syntax_Print.tag_of_sigelt se in @@ -4684,9 +4691,7 @@ let (tc_decls : if uu___6 then FStar_TypeChecker_Env.toggle_id_info env1 false else ()); - (let uu___7 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "IdInfoOn") in + (let uu___7 = FStar_Compiler_Effect.op_Bang dbg_IdInfoOn in if uu___7 then FStar_TypeChecker_Env.toggle_id_info env1 true else ()); @@ -4708,8 +4713,7 @@ let (tc_decls : FStar_Compiler_List.map (fun se1 -> (let uu___9 = - FStar_TypeChecker_Env.debug env2 - (FStar_Options.Other "UF") in + FStar_Compiler_Effect.op_Bang dbg_UF in if uu___9 then let uu___10 = @@ -4723,8 +4727,7 @@ let (tc_decls : FStar_Compiler_List.map (fun se1 -> (let uu___9 = - FStar_TypeChecker_Env.debug env2 - (FStar_Options.Other "UF") in + FStar_Compiler_Effect.op_Bang dbg_UF in if uu___9 then let uu___10 = @@ -4748,21 +4751,15 @@ let (tc_decls : env2 ses'2 in FStar_Syntax_Unionfind.reset (); (let uu___11 = - (FStar_Options.log_types ()) || - (FStar_TypeChecker_Env.debug env3 - (FStar_Options.Other "LogTypes")) in + ((FStar_Options.log_types ()) || + (FStar_Compiler_Debug.medium ())) + || (FStar_Compiler_Effect.op_Bang dbg_LogTypes) in if uu___11 then let uu___12 = - FStar_Compiler_List.fold_left - (fun s -> - fun se1 -> - let uu___13 = - let uu___14 = - FStar_Syntax_Print.sigelt_to_string - se1 in - Prims.strcat uu___14 "\n" in - Prims.strcat s uu___13) "" ses'2 in + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Syntax_Print.showable_sigelt) ses'2 in FStar_Compiler_Util.print1 "Checked: %s\n" uu___12 else ()); (let uu___12 = @@ -4815,7 +4812,7 @@ let (tc_decls : ([], env) ses) in match uu___ with | (ses1, env1) -> ((FStar_Compiler_List.rev_append ses1 []), env1) -let (uu___876 : unit) = +let (uu___873 : unit) = FStar_Compiler_Effect.op_Colon_Equals tc_decls_knot (FStar_Pervasives_Native.Some tc_decls) let (snapshot_context : @@ -4868,20 +4865,30 @@ let (tc_partial_modul : if modul.FStar_Syntax_Syntax.is_interface then "interface" else "implementation" in - (let uu___1 = FStar_Options.debug_any () in + (let uu___1 = FStar_Compiler_Debug.any () in if uu___1 then let uu___2 = FStar_Ident.string_of_lid modul.FStar_Syntax_Syntax.name in FStar_Compiler_Util.print3 "Now %s %s of %s\n" action label uu___2 else ()); + FStar_Compiler_Debug.disable_all (); + (let uu___3 = + let uu___4 = + FStar_Ident.string_of_lid modul.FStar_Syntax_Syntax.name in + FStar_Options.should_check uu___4 in + if uu___3 + then + let uu___4 = FStar_Options.debug_keys () in + FStar_Compiler_Debug.enable_toggles uu___4 + else ()); (let name = - let uu___1 = + let uu___3 = FStar_Ident.string_of_lid modul.FStar_Syntax_Syntax.name in FStar_Compiler_Util.format2 "%s %s" (if modul.FStar_Syntax_Syntax.is_interface then "interface" - else "module") uu___1 in + else "module") uu___3 in let env1 = { FStar_TypeChecker_Env.solver = (env.FStar_TypeChecker_Env.solver); @@ -4982,23 +4989,23 @@ let (tc_partial_modul : let env2 = FStar_TypeChecker_Env.set_current_module env1 modul.FStar_Syntax_Syntax.name in - let uu___1 = - let uu___2 = - let uu___3 = + let uu___3 = + let uu___4 = + let uu___5 = FStar_Ident.string_of_lid modul.FStar_Syntax_Syntax.name in - FStar_Options.should_check uu___3 in - Prims.op_Negation uu___2 in - let uu___2 = - let uu___3 = + FStar_Options.should_check uu___5 in + Prims.op_Negation uu___4 in + let uu___4 = + let uu___5 = FStar_Ident.string_of_lid modul.FStar_Syntax_Syntax.name in - FStar_Compiler_Util.format2 "While loading dependency %s%s" uu___3 + FStar_Compiler_Util.format2 "While loading dependency %s%s" uu___5 (if modul.FStar_Syntax_Syntax.is_interface then " (interface)" else "") in - FStar_Errors.with_ctx_if uu___1 uu___2 - (fun uu___3 -> - let uu___4 = tc_decls env2 modul.FStar_Syntax_Syntax.declarations in - match uu___4 with + FStar_Errors.with_ctx_if uu___3 uu___4 + (fun uu___5 -> + let uu___6 = tc_decls env2 modul.FStar_Syntax_Syntax.declarations in + match uu___6 with | (ses, env3) -> ({ FStar_Syntax_Syntax.name = @@ -5112,10 +5119,19 @@ let (load_checked_module : = fun en -> fun m -> - let m1 = deep_compress_modul m in - let env = load_checked_module_sigelts en m1 in - let uu___ = finish_partial_modul true true env m1 in - match uu___ with | (uu___1, env1) -> env1 + (let uu___1 = + (let uu___2 = FStar_Ident.string_of_lid m.FStar_Syntax_Syntax.name in + FStar_Options.should_check uu___2) || + (FStar_Options.debug_all_modules ()) in + if uu___1 + then + let uu___2 = FStar_Options.debug_keys () in + FStar_Compiler_Debug.enable_toggles uu___2 + else FStar_Compiler_Debug.disable_all ()); + (let m1 = deep_compress_modul m in + let env = load_checked_module_sigelts en m1 in + let uu___1 = finish_partial_modul true true env m1 in + match uu___1 with | (uu___2, env1) -> env1) let (load_partial_checked_module : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.modul -> FStar_TypeChecker_Env.env) @@ -5131,7 +5147,7 @@ let (check_module : fun env -> fun m -> fun b -> - (let uu___1 = FStar_Options.debug_any () in + (let uu___1 = FStar_Compiler_Debug.any () in if uu___1 then let uu___2 = @@ -5274,10 +5290,7 @@ let (check_module : (let uu___6 = FStar_Ident.string_of_lid m1.FStar_Syntax_Syntax.name in FStar_Options.dump_module uu___6) && - (let uu___6 = - FStar_Ident.string_of_lid m1.FStar_Syntax_Syntax.name in - FStar_Options.debug_at_level uu___6 - (FStar_Options.Other "Normalize")) in + (FStar_Compiler_Effect.op_Bang dbg_Normalize) in if uu___5 then let normalize_toplevel_lets se = diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcEffect.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcEffect.ml index 226e42cdf27..acec18567e9 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcEffect.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcEffect.ml @@ -1,4 +1,8 @@ open Prims +let (dbg : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ED" +let (dbg_LayeredEffectsTc : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "LayeredEffectsTc" let (dmff_cps_and_elaborate : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.eff_decl -> @@ -266,8 +270,9 @@ let (bind_combinator_kind : fun has_range_binders -> let debug s = let uu___ = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsTc") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___ then FStar_Compiler_Util.print1 "%s\n" s else () in @@ -1626,11 +1631,11 @@ let (validate_indexed_effect_bind_shape : FStar_Syntax_Syntax.Substitutive_combinator l in (let uu___8 = - FStar_TypeChecker_Env.debug - env + (FStar_Compiler_Debug.medium + ()) || ( - FStar_Options.Other - "LayeredEffectsTc") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___8 then let uu___9 @@ -2399,9 +2404,9 @@ let (validate_indexed_effect_subcomp_shape : (FStar_Compiler_List.op_At (a_b :: rest_bs) [f]) c in ((let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other - "LayeredEffectsTc") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___4 then let uu___5 = @@ -2458,9 +2463,10 @@ let (validate_indexed_effect_subcomp_shape : | FStar_Pervasives_Native.Some k2 -> k2 in (let uu___6 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other - "LayeredEffectsTc") in + (FStar_Compiler_Debug.medium ()) + || + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___6 then let uu___7 = @@ -3096,9 +3102,9 @@ let (validate_indexed_effect_ite_shape : FStar_Syntax_Syntax.Ad_hoc_combinator) | FStar_Pervasives_Native.Some k2 -> k2 in (let uu___5 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other - "LayeredEffectsTc") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___5 then let uu___6 = @@ -3730,9 +3736,10 @@ let (validate_indexed_effect_lift_shape : FStar_Syntax_Syntax.Substitutive_combinator l in (let uu___8 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other - "LayeredEffectsTc") in + (FStar_Compiler_Debug.medium ()) + || + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___8 then let uu___9 = @@ -3762,8 +3769,7 @@ let (tc_layered_eff_decl : FStar_Errors.with_ctx uu___ (fun uu___1 -> (let uu___3 = - FStar_TypeChecker_Env.debug env0 - (FStar_Options.Other "LayeredEffectsTc") in + FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsTc in if uu___3 then let uu___4 = FStar_Syntax_Print.eff_decl_to_string false ed in @@ -3797,8 +3803,7 @@ let (tc_layered_eff_decl : match uu___4 with | (us, t, ty) -> let uu___5 = - FStar_TypeChecker_Env.debug env0 - (FStar_Options.Other "LayeredEffectsTc") in + FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsTc in if uu___5 then let uu___6 = @@ -4298,9 +4303,8 @@ let (tc_layered_eff_decl : | (stronger_us, stronger_t, stronger_ty) -> ((let uu___14 = - FStar_TypeChecker_Env.debug env0 - (FStar_Options.Other - "LayeredEffectsTc") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc in if uu___14 then let uu___15 = @@ -5732,10 +5736,11 @@ let (tc_layered_eff_decl : | (act_defn, uu___19, g_d) -> ((let uu___21 = - FStar_TypeChecker_Env.debug - env1 - (FStar_Options.Other - "LayeredEffectsTc") in + (FStar_Compiler_Debug.medium + ()) + || + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___21 then let uu___22 = @@ -5867,10 +5872,10 @@ let (tc_layered_eff_decl : | (k, g_k) -> ((let uu___23 = - FStar_TypeChecker_Env.debug - env1 - (FStar_Options.Other - "LayeredEffectsTc") in + (FStar_Compiler_Debug.medium + ()) || + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___23 then @@ -5897,10 +5902,10 @@ let (tc_layered_eff_decl : ( let uu___25 = - FStar_TypeChecker_Env.debug - env1 - (FStar_Options.Other - "LayeredEffectsTc") in + (FStar_Compiler_Debug.medium + ()) || + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___25 then @@ -6069,10 +6074,10 @@ let (tc_layered_eff_decl : ( let uu___26 = - FStar_TypeChecker_Env.debug - env1 - (FStar_Options.Other - "LayeredEffectsTc") in + (FStar_Compiler_Debug.medium + ()) || + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___26 then @@ -6344,10 +6349,8 @@ let (tc_layered_eff_decl : FStar_Syntax_Syntax.Extract_none m))) in (let uu___15 = - FStar_TypeChecker_Env.debug - env0 - (FStar_Options.Other - "LayeredEffectsTc") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc in if uu___15 then let uu___16 = @@ -6452,8 +6455,7 @@ let (tc_non_layered_eff_decl : "While checking effect definition `%s`" uu___1 in FStar_Errors.with_ctx uu___ (fun uu___1 -> - (let uu___3 = - FStar_TypeChecker_Env.debug env0 (FStar_Options.Other "ED") in + (let uu___3 = FStar_Compiler_Effect.op_Bang dbg in if uu___3 then let uu___4 = FStar_Syntax_Print.eff_decl_to_string false ed in @@ -6675,8 +6677,7 @@ let (tc_non_layered_eff_decl : (ed1.FStar_Syntax_Syntax.extraction_mode) } in ((let uu___7 = - FStar_TypeChecker_Env.debug env0 - (FStar_Options.Other "ED") in + FStar_Compiler_Effect.op_Bang dbg in if uu___7 then let uu___8 = @@ -6811,8 +6812,7 @@ let (tc_non_layered_eff_decl : FStar_Pervasives_Native.None uu___7 FStar_Pervasives_Native.None in (let uu___8 = - FStar_TypeChecker_Env.debug env0 - (FStar_Options.Other "ED") in + FStar_Compiler_Effect.op_Bang dbg in if uu___8 then let uu___9 = @@ -6878,8 +6878,7 @@ let (tc_non_layered_eff_decl : | uu___12 -> fail signature1) in let log_combinator s ts = let uu___8 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "ED") in + FStar_Compiler_Effect.op_Bang dbg in if uu___8 then let uu___9 = @@ -8093,10 +8092,8 @@ let (tc_non_layered_eff_decl : } in ((let uu___25 = - FStar_TypeChecker_Env.debug - env1 - (FStar_Options.Other - "ED") in + FStar_Compiler_Effect.op_Bang + dbg in if uu___25 then let uu___26 @@ -8692,9 +8689,8 @@ let (tc_non_layered_eff_decl : (ed2.FStar_Syntax_Syntax.extraction_mode) } in ((let uu___16 = - FStar_TypeChecker_Env.debug - env - (FStar_Options.Other "ED") in + FStar_Compiler_Effect.op_Bang + dbg in if uu___16 then let uu___17 = @@ -8763,9 +8759,7 @@ let (tc_layered_lift : = fun env0 -> fun sub -> - (let uu___1 = - FStar_TypeChecker_Env.debug env0 - (FStar_Options.Other "LayeredEffectsTc") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsTc in if uu___1 then let uu___2 = FStar_Syntax_Print.sub_eff_to_string sub in @@ -8776,9 +8770,7 @@ let (tc_layered_lift : let uu___1 = check_and_gen env0 "" "lift" Prims.int_one lift_ts in match uu___1 with | (us, lift, lift_ty) -> - ((let uu___3 = - FStar_TypeChecker_Env.debug env0 - (FStar_Options.Other "LayeredEffectsTc") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsTc in if uu___3 then let uu___4 = FStar_Syntax_Print.tscheme_to_string (us, lift) in @@ -8817,8 +8809,7 @@ let (tc_layered_lift : (FStar_Pervasives_Native.Some kind) } in ((let uu___6 = - FStar_TypeChecker_Env.debug env0 - (FStar_Options.Other "LayeredEffectsTc") in + FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsTc in if uu___6 then let uu___7 = @@ -9055,8 +9046,7 @@ let (tc_lift : (match uu___7 with | (uvs, lift1) -> ((let uu___9 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "ED") in + FStar_Compiler_Effect.op_Bang dbg in if uu___9 then let uu___10 = @@ -9757,8 +9747,7 @@ let (tc_polymonadic_bind : (match uu___4 with | (k, kind) -> ((let uu___6 = - FStar_TypeChecker_Env.debug env1 - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___6 then let uu___7 = @@ -9846,9 +9835,7 @@ let (tc_polymonadic_subcomp : Prims.int_zero uu___10 in (match uu___4 with | (k, kind) -> - ((let uu___6 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + ((let uu___6 = FStar_Compiler_Debug.extreme () in if uu___6 then let uu___7 = diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml index 94816b95c80..5b73f17e71c 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml @@ -1,4 +1,8 @@ open Prims +let (dbg_GenUniverses : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "GenUniverses" +let (dbg_LogTypes : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "LogTypes" let (unfold_whnf : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term) @@ -408,9 +412,7 @@ let (tc_data : | uu___5 -> ([], t3) in (match uu___3 with | (arguments, result) -> - ((let uu___5 = - FStar_TypeChecker_Env.debug env2 - FStar_Options.Low in + ((let uu___5 = FStar_Compiler_Debug.low () in if uu___5 then let uu___6 = @@ -762,9 +764,7 @@ let (generalize_and_inst_within : let uu___ = FStar_Syntax_Syntax.mk_Total FStar_Syntax_Syntax.t_unit in FStar_Syntax_Util.arrow (FStar_Compiler_List.op_At binders binders') uu___ in - (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "GenUniverses") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_GenUniverses in if uu___1 then let uu___2 = FStar_TypeChecker_Normalize.term_to_string env t in @@ -774,9 +774,7 @@ let (generalize_and_inst_within : (let uu___1 = FStar_TypeChecker_Generalize.generalize_universes env t in match uu___1 with | (uvs, t1) -> - ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "GenUniverses") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_GenUniverses in if uu___3 then let uu___4 = @@ -1968,9 +1966,7 @@ let (check_inductive_well_typedness : let g' = FStar_TypeChecker_Rel.universe_inequality FStar_Syntax_Syntax.U_zero tc_u in - ((let uu___6 = - FStar_TypeChecker_Env.debug env2 - FStar_Options.Low in + ((let uu___6 = FStar_Compiler_Debug.low () in if uu___6 then let uu___7 = @@ -2027,8 +2023,7 @@ let (check_inductive_well_typedness : (g2.FStar_TypeChecker_Common.implicits) } in (let uu___6 = - FStar_TypeChecker_Env.debug env0 - (FStar_Options.Other "GenUniverses") in + FStar_Compiler_Effect.op_Bang dbg_GenUniverses in if uu___6 then let uu___7 = @@ -2522,8 +2517,7 @@ let (mk_discriminator_and_indexed_projectors : FStar_Pervasives_Native.None } in (let uu___2 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LogTypes") in + FStar_Compiler_Effect.op_Bang dbg_LogTypes in if uu___2 then let uu___3 = @@ -2688,8 +2682,8 @@ let (mk_discriminator_and_indexed_projectors : FStar_Pervasives_Native.None } in (let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LogTypes") in + FStar_Compiler_Effect.op_Bang + dbg_LogTypes in if uu___4 then let uu___5 = @@ -2854,10 +2848,8 @@ let (mk_discriminator_and_indexed_projectors : FStar_Pervasives_Native.None } in ((let uu___8 = - FStar_TypeChecker_Env.debug - env - (FStar_Options.Other - "LogTypes") in + FStar_Compiler_Effect.op_Bang + dbg_LogTypes in if uu___8 then let uu___9 = @@ -3110,10 +3102,8 @@ let (mk_discriminator_and_indexed_projectors : FStar_Pervasives_Native.None } in (let uu___10 = - FStar_TypeChecker_Env.debug - env - (FStar_Options.Other - "LogTypes") in + FStar_Compiler_Effect.op_Bang + dbg_LogTypes in if uu___10 then let uu___11 = diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml index 3946271c045..f6dbea580ca 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml @@ -1,4 +1,22 @@ open Prims +let (dbg_Exports : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Exports" +let (dbg_LayeredEffects : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "LayeredEffects" +let (dbg_NYC : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "NYC" +let (dbg_Patterns : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Patterns" +let (dbg_Range : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Range" +let (dbg_RelCheck : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "RelCheck" +let (dbg_RFD : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "RFD" +let (dbg_Tac : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Tac" +let (dbg_UniverseOf : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "UniverseOf" let (instantiate_both : FStar_TypeChecker_Env.env -> FStar_TypeChecker_Env.env) = fun env -> @@ -518,9 +536,7 @@ let (value_check_expected_typ : lc t' use_eq in (match uu___3 with | (e1, lc1, g) -> - ((let uu___5 = - FStar_TypeChecker_Env.debug env - FStar_Options.Medium in + ((let uu___5 = FStar_Compiler_Debug.medium () in if uu___5 then let uu___6 = @@ -782,9 +798,7 @@ let (check_expected_effect : c4.FStar_Syntax_Syntax.pos "check_expected_effect.c.after_assume" env c4; - (let uu___8 = - FStar_TypeChecker_Env.debug env - FStar_Options.Medium in + (let uu___8 = FStar_Compiler_Debug.medium () in if uu___8 then let uu___9 = @@ -815,8 +829,7 @@ let (check_expected_effect : FStar_TypeChecker_Util.label_guard uu___10 uu___11 g in ((let uu___11 = - FStar_TypeChecker_Env.debug env - FStar_Options.Medium in + FStar_Compiler_Debug.medium () in if uu___11 then let uu___12 = @@ -1262,8 +1275,7 @@ let (guard_letrecs : (env.FStar_TypeChecker_Env.core_check) } in let decreases_clause bs c = - (let uu___1 = - FStar_TypeChecker_Env.debug env1 FStar_Options.Low in + (let uu___1 = FStar_Compiler_Debug.low () in if uu___1 then let uu___2 = FStar_Syntax_Print.binders_to_string ", " bs in @@ -1639,9 +1651,7 @@ let (guard_letrecs : FStar_Compiler_List.op_At bs uu___4 in let t' = FStar_Syntax_Util.arrow refined_formals c in - ((let uu___5 = - FStar_TypeChecker_Env.debug env1 - FStar_Options.Medium in + ((let uu___5 = FStar_Compiler_Debug.medium () in if uu___5 then let uu___6 = @@ -1718,7 +1728,7 @@ let rec (tc_term : FStar_Defensive.def_check_scoped FStar_TypeChecker_Env.hasBinders_env FStar_Class_Binders.hasNames_term FStar_Syntax_Print.pretty_term e.FStar_Syntax_Syntax.pos "tc_term.entry" env e; - (let uu___2 = FStar_TypeChecker_Env.debug env FStar_Options.Medium in + (let uu___2 = FStar_Compiler_Debug.medium () in if uu___2 then let uu___3 = @@ -1845,8 +1855,7 @@ let rec (tc_term : } e) in match uu___2 with | (r, ms) -> - ((let uu___4 = - FStar_TypeChecker_Env.debug env FStar_Options.Medium in + ((let uu___4 = FStar_Compiler_Debug.medium () in if uu___4 then ((let uu___6 = @@ -1893,7 +1902,7 @@ and (tc_maybe_toplevel_term : FStar_Class_Binders.hasNames_term FStar_Syntax_Print.pretty_term e.FStar_Syntax_Syntax.pos "tc_maybe_toplevel_term.entry" env1 e; (let top = FStar_Syntax_Subst.compress e in - (let uu___2 = FStar_TypeChecker_Env.debug env1 FStar_Options.Medium in + (let uu___2 = FStar_Compiler_Debug.medium () in if uu___2 then let uu___3 = @@ -2479,9 +2488,7 @@ and (tc_maybe_toplevel_term : FStar_Syntax_Syntax.Tm_ascribed uu___12 in FStar_Syntax_Syntax.mk uu___11 e1.FStar_Syntax_Syntax.pos in - (let uu___12 = - FStar_TypeChecker_Env.debug env0 - FStar_Options.Extreme in + (let uu___12 = FStar_Compiler_Debug.extreme () in if uu___12 then let uu___13 = @@ -2495,8 +2502,7 @@ and (tc_maybe_toplevel_term : | (e3, uu___13, g_e) -> let e4 = FStar_Syntax_Util.unascribe e3 in ((let uu___15 = - FStar_TypeChecker_Env.debug env0 - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___15 then let uu___16 = @@ -3367,9 +3373,7 @@ and (tc_maybe_toplevel_term : let uu___9 = FStar_Syntax_Util.head_and_args t0 in (match uu___9 with | (thead, uu___10) -> - ((let uu___12 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "RFD") in + ((let uu___12 = FStar_Compiler_Effect.op_Bang dbg_RFD in if uu___12 then let uu___13 = @@ -3503,8 +3507,7 @@ and (tc_maybe_toplevel_term : let uu___3 = FStar_TypeChecker_Env.clear_expected_typ env1 in FStar_Pervasives_Native.fst uu___3 in instantiate_both uu___2 in - ((let uu___3 = - FStar_TypeChecker_Env.debug env2 FStar_Options.High in + ((let uu___3 = FStar_Compiler_Debug.high () in if uu___3 then let uu___4 = @@ -3575,8 +3578,7 @@ and (tc_maybe_toplevel_term : (match uu___6 with | (e2, c1, implicits) -> ((let uu___8 = - FStar_TypeChecker_Env.debug env2 - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___8 then let uu___9 = @@ -3597,8 +3599,7 @@ and (tc_maybe_toplevel_term : FStar_TypeChecker_Env.conj_guard gres implicits in ((let uu___10 = - FStar_TypeChecker_Env.debug env2 - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___10 then let uu___11 = @@ -4170,8 +4171,7 @@ and (tc_match : (match uu___6 with | (e2, cres2, g_expected_type) -> ((let uu___8 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___8 then let uu___9 = @@ -4225,8 +4225,7 @@ and (tc_synth : "synth_by_tactic: bad application") rng in match uu___ with | (tau, atyp) -> - ((let uu___2 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Tac") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___2 then let uu___3 = @@ -4295,8 +4294,7 @@ and (tc_synth : (tau1.FStar_Syntax_Syntax.hash_code) } in (let uu___9 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Tac") in + FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___9 then let uu___10 = @@ -4678,9 +4676,7 @@ and (tc_value : | ((us, t), range) -> let fv1 = FStar_Syntax_Syntax.set_range_of_fv fv range in (maybe_warn_on_use env1 fv1; - (let uu___3 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "Range") in + (let uu___3 = FStar_Compiler_Effect.op_Bang dbg_Range in if uu___3 then let uu___4 = @@ -4788,9 +4784,7 @@ and (tc_value : tc_binder env2 uu___4 in (match uu___3 with | (x2, env3, f1, u) -> - ((let uu___5 = - FStar_TypeChecker_Env.debug env3 - FStar_Options.High in + ((let uu___5 = FStar_Compiler_Debug.high () in if uu___5 then let uu___6 = @@ -4848,8 +4842,7 @@ and (tc_value : FStar_Syntax_Syntax.rc_opt = uu___;_} -> let bs1 = FStar_TypeChecker_Util.maybe_add_implicit_binders env1 bs in - ((let uu___2 = - FStar_TypeChecker_Env.debug env1 FStar_Options.Medium in + ((let uu___2 = FStar_Compiler_Debug.medium () in if uu___2 then let uu___3 = @@ -6052,9 +6045,7 @@ and (tc_abs_check_binders : (expected_t, FStar_TypeChecker_Env.trivial_guard) | uu___5 -> - ((let uu___7 = - FStar_TypeChecker_Env.debug env1 - FStar_Options.High in + ((let uu___7 = FStar_Compiler_Debug.high () in if uu___7 then let uu___8 = @@ -6203,8 +6194,7 @@ and (tc_abs : let uu___ = FStar_TypeChecker_Env.clear_expected_typ env in match uu___ with | (env1, topt) -> - ((let uu___2 = - FStar_TypeChecker_Env.debug env1 FStar_Options.High in + ((let uu___2 = FStar_Compiler_Debug.high () in if uu___2 then let uu___3 = @@ -6230,9 +6220,7 @@ and (tc_abs : match uu___2 with | (tfun_opt, bs1, letrec_binders, c_opt, envbody, body1, g_env) -> - ((let uu___4 = - FStar_TypeChecker_Env.debug env1 - FStar_Options.Extreme in + ((let uu___4 = FStar_Compiler_Debug.extreme () in if uu___4 then let uu___5 = @@ -6262,9 +6250,7 @@ and (tc_abs : "After expected_function_typ, tfun_opt: %s, c_opt: %s, and expected type in envbody: %s\n" uu___5 uu___6 uu___7 else ()); - (let uu___5 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "NYC") in + (let uu___5 = FStar_Compiler_Effect.op_Bang dbg_NYC in if uu___5 then let uu___6 = @@ -6510,9 +6496,7 @@ and (tc_abs : (body3, cbody1, uu___10)))) in match uu___5 with | (body2, cbody, guard_body) -> - ((let uu___7 = - FStar_TypeChecker_Env.debug env1 - FStar_Options.Extreme in + ((let uu___7 = FStar_Compiler_Debug.extreme () in if uu___7 then let uu___8 = @@ -6524,9 +6508,7 @@ and (tc_abs : (let guard_body1 = if env1.FStar_TypeChecker_Env.top_level then - ((let uu___8 = - FStar_TypeChecker_Env.debug env1 - FStar_Options.Medium in + ((let uu___8 = FStar_Compiler_Debug.medium () in if uu___8 then let uu___9 = @@ -6694,8 +6676,7 @@ and (check_application_args : let n_args = FStar_Compiler_List.length args in let r = FStar_TypeChecker_Env.get_range env in let thead = FStar_Syntax_Util.comp_result chead in - (let uu___1 = - FStar_TypeChecker_Env.debug env FStar_Options.High in + (let uu___1 = FStar_Compiler_Debug.high () in if uu___1 then let uu___2 = @@ -6748,8 +6729,7 @@ and (check_application_args : (match uu___4 with | (cres2, guard2) -> ((let uu___6 = - FStar_TypeChecker_Env.debug env - FStar_Options.Medium in + FStar_Compiler_Debug.medium () in if uu___6 then let uu___7 = @@ -6809,8 +6789,8 @@ and (check_application_args : if uu___8 then ((let uu___10 = - FStar_TypeChecker_Env.debug - env FStar_Options.Extreme in + FStar_Compiler_Debug.extreme + () in if uu___10 then let uu___11 = @@ -6826,8 +6806,8 @@ and (check_application_args : (uu___10, true))) else ((let uu___11 = - FStar_TypeChecker_Env.debug - env FStar_Options.Extreme in + FStar_Compiler_Debug.extreme + () in if uu___11 then let uu___12 = @@ -6885,9 +6865,8 @@ and (check_application_args : ((e, q), x, c)) -> ((let uu___12 = - FStar_TypeChecker_Env.debug - env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme + () in if uu___12 then let uu___13 @@ -6974,9 +6953,8 @@ and (check_application_args : env arg_rets_names_opt in ((let uu___11 = - FStar_TypeChecker_Env.debug - env1 - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme + () in if uu___11 then let uu___12 = @@ -7060,9 +7038,8 @@ and (check_application_args : | ((e, q), uu___11, c) -> ((let uu___13 = - FStar_TypeChecker_Env.debug - env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme + () in if uu___13 then let uu___14 = @@ -7083,9 +7060,8 @@ and (check_application_args : then ((let uu___15 = - FStar_TypeChecker_Env.debug - env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme + () in if uu___15 then FStar_Compiler_Util.print_string @@ -7161,9 +7137,8 @@ and (check_application_args : else (); (let uu___17 = - FStar_TypeChecker_Env.debug - env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme + () in if uu___17 then FStar_Compiler_Util.print_string @@ -7309,9 +7284,8 @@ and (check_application_args : (match uu___8 with | (comp1, g) -> ((let uu___10 = - FStar_TypeChecker_Env.debug - env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme + () in if uu___10 then let uu___11 = @@ -7560,9 +7534,7 @@ and (check_application_args : (x.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = targ } in - ((let uu___4 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + ((let uu___4 = FStar_Compiler_Debug.extreme () in if uu___4 then let uu___5 = @@ -7596,9 +7568,7 @@ and (check_application_args : let env1 = FStar_TypeChecker_Env.set_expected_typ_maybe_eq env targ1 (is_eq bqual1) in - ((let uu___6 = - FStar_TypeChecker_Env.debug env1 - FStar_Options.High in + ((let uu___6 = FStar_Compiler_Debug.high () in if uu___6 then let uu___7 = @@ -7696,8 +7666,8 @@ and (check_application_args : (head1, chead2, ghead3, cres'1) in ((let uu___7 = - FStar_TypeChecker_Env.debug - env FStar_Options.Low in + FStar_Compiler_Debug.low + () in if uu___7 then FStar_Errors.log_issue @@ -7862,9 +7832,7 @@ and (check_application_args : (match uu___4 with | (cres, guard2) -> let bs_cres = FStar_Syntax_Util.arrow bs cres in - ((let uu___6 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + ((let uu___6 = FStar_Compiler_Debug.extreme () in if uu___6 then let uu___7 = @@ -7951,8 +7919,7 @@ and (check_application_args : | (cres, guard2) -> let bs_cres = FStar_Syntax_Util.arrow bs cres in ((let uu___10 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___10 then let uu___11 = @@ -7982,9 +7949,7 @@ and (check_application_args : (match uu___2 with | (bs1, c1) -> let head_info = (head, chead, ghead, c1) in - ((let uu___4 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + ((let uu___4 = FStar_Compiler_Debug.extreme () in if uu___4 then let uu___5 = @@ -8186,9 +8151,7 @@ and (tc_pat : scrutinee_t in aux false uu___ in let pat_typ_ok env1 pat_t1 scrutinee_t = - (let uu___1 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "Patterns") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Patterns in if uu___1 then let uu___2 = FStar_Syntax_Print.term_to_string pat_t1 in @@ -8656,9 +8619,7 @@ and (tc_pat : formals args)))) | uu___1 -> fail "Not a simple pattern") in let rec check_nested_pattern env1 p t = - (let uu___1 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "Patterns") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Patterns in if uu___1 then let uu___2 = FStar_Syntax_Print.pat_to_string p in @@ -8956,8 +8917,7 @@ and (tc_pat : let guard2 = FStar_TypeChecker_Env.conj_guard guard1 g' in ((let uu___6 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "Patterns") in + FStar_Compiler_Effect.op_Bang dbg_Patterns in if uu___6 then let uu___7 = @@ -9140,8 +9100,7 @@ and (tc_pat : let uu___6 = reconstruct_nested_pat simple_pat_elab in (bvs, tms, pat_e, uu___6, g, erasable1)))))) in - (let uu___1 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Patterns") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Patterns in if uu___1 then let uu___2 = FStar_Syntax_Print.pat_to_string p0 in @@ -9160,9 +9119,7 @@ and (tc_pat : let pat_e_norm = FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Env.Beta] extended_env pat_e in - ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Patterns") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_Patterns in if uu___3 then let uu___4 = FStar_Syntax_Print.pat_to_string pat in @@ -9212,9 +9169,7 @@ and (tc_eqn : (match uu___5 with | (pattern1, pat_bvs, pat_bv_tms, pat_env, pat_exp, norm_pat_exp, guard_pat, erasable) -> - ((let uu___7 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + ((let uu___7 = FStar_Compiler_Debug.extreme () in if uu___7 then let uu___8 = @@ -9712,8 +9667,7 @@ and (tc_eqn : branch_guard1 w in branch_guard2) in (let uu___11 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___11 then let uu___12 = @@ -9935,10 +9889,8 @@ and (tc_eqn : then ((let uu___16 = - FStar_TypeChecker_Env.debug - env - (FStar_Options.Other - "LayeredEffects") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffects in if uu___16 then FStar_Compiler_Util.print_string @@ -10189,10 +10141,8 @@ and (tc_eqn : uu___16 in (let uu___17 = - FStar_TypeChecker_Env.debug - env - (FStar_Options.Other - "LayeredEffects") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffects in if uu___17 then let uu___18 @@ -10317,8 +10267,8 @@ and (tc_eqn : FStar_TypeChecker_Env.conj_guard g_when1 g_branch1 in ((let uu___13 = - FStar_TypeChecker_Env.debug - env FStar_Options.High in + FStar_Compiler_Debug.high + () in if uu___13 then let uu___14 = @@ -10431,9 +10381,7 @@ and (check_top_level_let : (uu___6, c12))) in (match uu___2 with | (e21, c12) -> - ((let uu___4 = - FStar_TypeChecker_Env.debug env1 - FStar_Options.Medium in + ((let uu___4 = FStar_Compiler_Debug.medium () in if uu___4 then let uu___5 = @@ -10456,9 +10404,7 @@ and (check_top_level_let : FStar_TypeChecker_Env.DoNotUnfoldPureLets] env1 e11 else e11 in - (let uu___5 = - FStar_TypeChecker_Env.debug env1 - FStar_Options.Medium in + (let uu___5 = FStar_Compiler_Debug.medium () in if uu___5 then let uu___6 = @@ -10791,8 +10737,7 @@ and (check_inner_let : FStar_Compiler_Option.get uu___7 in FStar_Pervasives_Native.fst uu___6 in ((let uu___7 = - FStar_TypeChecker_Env.debug env2 - (FStar_Options.Other "Exports") in + FStar_Compiler_Effect.op_Bang dbg_Exports in if uu___7 then let uu___8 = @@ -10813,8 +10758,8 @@ and (check_inner_let : match uu___7 with | (t, g_ex) -> ((let uu___9 = - FStar_TypeChecker_Env.debug env2 - (FStar_Options.Other "Exports") in + FStar_Compiler_Effect.op_Bang + dbg_Exports in if uu___9 then let uu___10 = @@ -11455,8 +11400,7 @@ and (build_let_rec_env : | FStar_Pervasives_Native.Some (arity, lbdef1) -> ((let uu___7 = - FStar_TypeChecker_Env.debug env2 - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___7 then let uu___8 = @@ -11911,9 +11855,7 @@ and (check_let_bound_def : | (c11, guard_f) -> let g11 = FStar_TypeChecker_Env.conj_guard g1 guard_f in - ((let uu___7 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + ((let uu___7 = FStar_Compiler_Debug.extreme () in if uu___7 then let uu___8 = @@ -11987,8 +11929,7 @@ and (check_lbtyp : (match uu___6 with | (t2, uu___7, g) -> ((let uu___9 = - FStar_TypeChecker_Env.debug env - FStar_Options.Medium in + FStar_Compiler_Debug.medium () in if uu___9 then let uu___10 = @@ -12025,8 +11966,7 @@ and (tc_binder : let uu___1 = FStar_Syntax_Util.type_u () in (match uu___1 with | (tu, u) -> - ((let uu___3 = - FStar_TypeChecker_Env.debug env FStar_Options.Extreme in + ((let uu___3 = FStar_Compiler_Debug.extreme () in if uu___3 then let uu___4 = FStar_Syntax_Print.bv_to_string x in @@ -12072,9 +12012,7 @@ and (tc_binder : (x.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = t } imp1 pqual attrs1 in - (let uu___9 = - FStar_TypeChecker_Env.debug env - FStar_Options.High in + (let uu___9 = FStar_Compiler_Debug.high () in if uu___9 then let uu___10 = @@ -12096,7 +12034,7 @@ and (tc_binders : = fun env -> fun bs -> - (let uu___1 = FStar_TypeChecker_Env.debug env FStar_Options.Extreme in + (let uu___1 = FStar_Compiler_Debug.extreme () in if uu___1 then let uu___2 = FStar_Syntax_Print.binders_to_string ", " bs in @@ -12307,8 +12245,7 @@ let (typeof_tot_or_gtot_term : fun env -> fun e -> fun must_tot -> - (let uu___1 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "RelCheck") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_RelCheck in if uu___1 then let uu___2 = FStar_Syntax_Print.term_to_string e in @@ -13006,8 +12943,7 @@ let rec (universe_of_aux : (env2.FStar_TypeChecker_Env.core_check) } in ((let uu___5 = - FStar_TypeChecker_Env.debug env3 - (FStar_Options.Other "UniverseOf") in + FStar_Compiler_Effect.op_Bang dbg_UniverseOf in if uu___5 then let uu___6 = @@ -13065,7 +13001,7 @@ let (universe_of : fun e -> FStar_Errors.with_ctx "While attempting to compute a universe level" (fun uu___ -> - (let uu___2 = FStar_TypeChecker_Env.debug env FStar_Options.High in + (let uu___2 = FStar_Compiler_Debug.high () in if uu___2 then let uu___3 = FStar_Syntax_Print.term_to_string e in @@ -13077,7 +13013,7 @@ let (universe_of : FStar_Class_Binders.hasNames_term FStar_Syntax_Print.pretty_term e.FStar_Syntax_Syntax.pos "universe_of entry" env e; (let r = universe_of_aux env e in - (let uu___4 = FStar_TypeChecker_Env.debug env FStar_Options.High in + (let uu___4 = FStar_Compiler_Debug.high () in if uu___4 then let uu___5 = FStar_Syntax_Print.term_to_string r in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml index 605de0d7a17..4ae03e87a65 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml @@ -2,6 +2,30 @@ open Prims type lcomp_with_binder = (FStar_Syntax_Syntax.bv FStar_Pervasives_Native.option * FStar_TypeChecker_Common.lcomp) +let (dbg_bind : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Bind" +let (dbg_Coercions : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Coercions" +let (dbg_Dec : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Dec" +let (dbg_Extraction : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Extraction" +let (dbg_LayeredEffects : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "LayeredEffects" +let (dbg_LayeredEffectsApp : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "LayeredEffectsApp" +let (dbg_Pat : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Pat" +let (dbg_Rel : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Rel" +let (dbg_ResolveImplicitsHook : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ResolveImplicitsHook" +let (dbg_Return : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Return" +let (dbg_Simplification : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Simplification" +let (dbg_SMTEncodingReify : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "SMTEncodingReify" let (report : FStar_TypeChecker_Env.env -> Prims.string Prims.list -> unit) = fun env -> fun errs -> @@ -45,9 +69,7 @@ let (close_guard_implicits : g.FStar_TypeChecker_Common.deferred in match uu___1 with | (solve_now, defer) -> - ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Rel") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___3 then (FStar_Compiler_Util.print_string @@ -155,9 +177,7 @@ let (extract_let_rec_annotation : | (u_subst, univ_vars1) -> let e1 = FStar_Syntax_Subst.subst u_subst e in let t2 = FStar_Syntax_Subst.subst u_subst t1 in - ((let uu___6 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Dec") in + ((let uu___6 = FStar_Compiler_Effect.op_Bang dbg_Dec in if uu___6 then let uu___7 = FStar_Syntax_Print.term_to_string e1 in @@ -845,9 +865,7 @@ let (mk_wp_return : FStar_Syntax_Syntax.mk_Tm_app uu___6 uu___7 e.FStar_Syntax_Syntax.pos) in mk_comp ed u_a a wp [FStar_Syntax_Syntax.RETURN])) in - (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Return") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Return in if uu___1 then let uu___2 = @@ -1264,8 +1282,7 @@ let (substitutive_indexed_close_substs : fun num_effect_params -> fun r -> let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in let uu___ = let uu___1 = close_bs in match uu___1 with @@ -1533,8 +1550,8 @@ let (substitutive_indexed_bind_substs : fun num_effect_params -> fun has_range_binders -> let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsApp in let bind_name uu___ = if debug then @@ -1900,8 +1917,7 @@ let (ad_hoc_indexed_bind_substs : fun r1 -> fun has_range_binders -> let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in let bind_name uu___ = if debug then @@ -1997,9 +2013,8 @@ let (ad_hoc_indexed_bind_substs : (match uu___1 with | (rest_bs_uvars, g_uvars) -> ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other - "ResolveImplicitsHook") in + FStar_Compiler_Effect.op_Bang + dbg_ResolveImplicitsHook in if uu___3 then FStar_Compiler_List.iter @@ -2068,10 +2083,8 @@ let (ad_hoc_indexed_bind_substs : fun i1 -> fun f_i1 -> (let uu___5 = - FStar_TypeChecker_Env.debug - env - (FStar_Options.Other - "ResolveImplicitsHook") in + FStar_Compiler_Effect.op_Bang + dbg_ResolveImplicitsHook in if uu___5 then let uu___6 = @@ -2170,10 +2183,8 @@ let (ad_hoc_indexed_bind_substs : fun i1 -> fun g_i1 -> (let uu___6 = - FStar_TypeChecker_Env.debug - env - (FStar_Options.Other - "ResolveImplicitsHook") in + FStar_Compiler_Effect.op_Bang + dbg_ResolveImplicitsHook in if uu___6 then let uu___7 = @@ -2218,9 +2229,7 @@ let (mk_indexed_return : fun a -> fun e -> fun r -> - let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + let debug = FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in if debug then (let uu___1 = @@ -2376,8 +2385,8 @@ let (mk_indexed_bind : fun num_effect_params -> fun has_range_binders -> let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsApp in if debug then (let uu___1 = @@ -2391,8 +2400,8 @@ let (mk_indexed_bind : uu___1 uu___2) else (); (let uu___2 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "ResolveImplicitsHook") in + FStar_Compiler_Effect.op_Bang + dbg_ResolveImplicitsHook in if uu___2 then let uu___3 = @@ -2621,10 +2630,8 @@ let (mk_indexed_bind : FStar_TypeChecker_Env.conj_guards uu___9 in (let uu___10 = - FStar_TypeChecker_Env.debug - env - (FStar_Options.Other - "ResolveImplicitsHook") in + FStar_Compiler_Effect.op_Bang + dbg_ResolveImplicitsHook in if uu___10 then let uu___11 = @@ -3041,9 +3048,7 @@ let (strengthen_precondition : match uu___5 with | FStar_TypeChecker_Common.Trivial -> (c, g_c) | FStar_TypeChecker_Common.NonTrivial f -> - ((let uu___7 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + ((let uu___7 = FStar_Compiler_Debug.extreme () in if uu___7 then let uu___8 = @@ -3154,10 +3159,8 @@ let (bind : | (b, lc2) -> let debug f = let uu___1 = - (FStar_TypeChecker_Env.debug env FStar_Options.Extreme) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "bind")) in + (FStar_Compiler_Debug.extreme ()) || + (FStar_Compiler_Effect.op_Bang dbg_bind) in if uu___1 then f () else () in let uu___1 = FStar_TypeChecker_Normalize.ghost_to_pure_lcomp2 env @@ -3864,8 +3867,7 @@ let (substitutive_indexed_ite_substs : fun num_effect_params -> fun r -> let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in let uu___ = let uu___1 = bs in match uu___1 with @@ -4083,8 +4085,7 @@ let (ad_hoc_indexed_ite_substs : fun ct_else -> fun r -> let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in let conjunction_name uu___ = if debug then @@ -4264,8 +4265,7 @@ let (mk_layered_conjunction : fun ct2 -> fun r -> let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in let conjunction_t_error s = let uu___ = let uu___1 = @@ -4831,8 +4831,7 @@ let (check_comp : FStar_Class_Binders.hasNames_comp FStar_Syntax_Print.pretty_comp c'.FStar_Syntax_Syntax.pos "check_comp.c'" env c'; - (let uu___3 = - FStar_TypeChecker_Env.debug env FStar_Options.Extreme in + (let uu___3 = FStar_Compiler_Debug.extreme () in if uu___3 then let uu___4 = FStar_Syntax_Print.term_to_string e in @@ -5008,8 +5007,7 @@ let (coerce_with : match uu___ with | FStar_Pervasives_Native.Some uu___1 -> ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Coercions") in + FStar_Compiler_Effect.op_Bang dbg_Coercions in if uu___3 then let uu___4 = FStar_Ident.string_of_lid f in @@ -5708,9 +5706,7 @@ let (maybe_coerce_lc : if Prims.op_Negation should_coerce then (e, lc, FStar_TypeChecker_Env.trivial_guard) else - ((let uu___2 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Coercions") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Coercions in if uu___2 then let uu___3 = @@ -5728,9 +5724,7 @@ let (maybe_coerce_lc : (let uu___2 = find_coercion env lc exp_t e in match uu___2 with | FStar_Pervasives_Native.Some (coerced, lc1, g) -> - ((let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Coercions") in + ((let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Coercions in if uu___4 then let uu___5 = @@ -5743,9 +5737,7 @@ let (maybe_coerce_lc : else ()); (coerced, lc1, g)) | FStar_Pervasives_Native.None -> - ((let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Coercions") in + ((let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Coercions in if uu___4 then let uu___5 = @@ -5845,7 +5837,7 @@ let (weaken_result_typ : fun lc -> fun t -> fun use_eq -> - (let uu___1 = FStar_TypeChecker_Env.debug env FStar_Options.High in + (let uu___1 = FStar_Compiler_Debug.high () in if uu___1 then let uu___2 = FStar_Syntax_Print.term_to_string e in @@ -5915,9 +5907,7 @@ let (weaken_result_typ : uu___5 = FStar_Syntax_Util.Equal in if uu___4 then - ((let uu___6 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + ((let uu___6 = FStar_Compiler_Debug.extreme () in if uu___6 then let uu___7 = @@ -5971,8 +5961,7 @@ let (weaken_result_typ : (FStar_Pervasives_Native.Some e) uu___7 uu___8 in ((let uu___8 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___8 then let uu___9 = @@ -6003,8 +5992,7 @@ let (weaken_result_typ : (uu___9, uu___10))) else ((let uu___8 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___8 then let uu___9 = @@ -6086,8 +6074,7 @@ let (weaken_result_typ : (match uu___7 with | (c, g_c) -> ((let uu___9 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___9 then let uu___10 = @@ -6189,9 +6176,8 @@ let (weaken_result_typ : (match uu___11 with | (c2, g_lc) -> ((let uu___13 = - FStar_TypeChecker_Env.debug - env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme + () in if uu___13 then let uu___14 = @@ -6398,9 +6384,7 @@ let (norm_reify : FStar_TypeChecker_Env.AllowUnboundUniverses; FStar_TypeChecker_Env.Exclude FStar_TypeChecker_Env.Zeta] steps) env t in - (let uu___2 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "SMTEncodingReify") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_SMTEncodingReify in if uu___2 then let uu___3 = FStar_Syntax_Print.term_to_string t in @@ -6466,7 +6450,7 @@ let (maybe_instantiate : if Prims.op_Negation env.FStar_TypeChecker_Env.instantiate_imp then (e, torig, FStar_TypeChecker_Env.trivial_guard) else - ((let uu___2 = FStar_TypeChecker_Env.debug env FStar_Options.High in + ((let uu___2 = FStar_Compiler_Debug.high () in if uu___2 then let uu___3 = @@ -6606,9 +6590,7 @@ let (maybe_instantiate : e.FStar_Syntax_Syntax.pos env t2 in (match uu___6 with | (v, uu___7, g) -> - ((let uu___9 = - FStar_TypeChecker_Env.debug env - FStar_Options.High in + ((let uu___9 = FStar_Compiler_Debug.high () in if uu___9 then let uu___10 = @@ -6668,9 +6650,7 @@ let (maybe_instantiate : (FStar_Pervasives_Native.Some meta_t) in (match uu___5 with | (v, uu___6, g) -> - ((let uu___8 = - FStar_TypeChecker_Env.debug env - FStar_Options.High in + ((let uu___8 = FStar_Compiler_Debug.high () in if uu___8 then let uu___9 = @@ -6784,9 +6764,7 @@ let (check_has_type_maybe_coerce : let g = check_has_type env1 e1 lc1.FStar_TypeChecker_Common.res_typ t2 use_eq in - ((let uu___2 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "Rel") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___2 then let uu___3 = FStar_TypeChecker_Rel.guard_to_string env1 g in @@ -6805,8 +6783,7 @@ let (check_top_level : fun lc -> FStar_Errors.with_ctx "While checking for top-level effects" (fun uu___ -> - (let uu___2 = - FStar_TypeChecker_Env.debug env FStar_Options.Medium in + (let uu___2 = FStar_Compiler_Debug.medium () in if uu___2 then let uu___3 = FStar_TypeChecker_Common.lcomp_to_string lc in @@ -6891,9 +6868,8 @@ let (check_top_level : FStar_Errors.raise_error uu___8 uu___9 | FStar_Pervasives_Native.Some (bs, uu___8) -> let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other - "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsApp in let uu___9 = FStar_Syntax_Subst.open_binders bs in (match uu___9 with @@ -6991,8 +6967,8 @@ let (check_top_level : match uu___7 with | (ct, vc, g_pre) -> ((let uu___9 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Simplification") in + FStar_Compiler_Effect.op_Bang + dbg_Simplification in if uu___9 then let uu___10 = @@ -7221,8 +7197,7 @@ let (must_erase_for_extraction : FStar_TypeChecker_Env.Unascribe] env t1 in let res = (FStar_TypeChecker_Env.non_informative env t2) || (descend env t2) in - (let uu___1 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Extraction") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Extraction in if uu___1 then let uu___2 = FStar_Syntax_Print.term_to_string t2 in @@ -7267,8 +7242,7 @@ let (fresh_effect_repr : match uu___ with | (uu___1, signature) -> let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in let uu___2 = let uu___3 = FStar_Syntax_Subst.compress signature in uu___3.FStar_Syntax_Syntax.n in @@ -7470,9 +7444,7 @@ let (substitutive_indexed_lift_substs : fun ct -> fun lift_name -> fun r -> - let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + let debug = FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in let uu___ = let uu___1 = bs in match uu___1 with @@ -7557,9 +7529,7 @@ let (ad_hoc_indexed_lift_substs : fun ct -> fun lift_name -> fun r -> - let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + let debug = FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in let lift_t_shape_error s = FStar_Compiler_Util.format2 "Lift %s has unexpected shape, reason: %s" lift_name s in @@ -7647,9 +7617,7 @@ let (lift_tf_layered_effect : fun kind -> fun env -> fun c -> - let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + let debug = FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in if debug then (let uu___1 = FStar_Syntax_Print.comp_to_string c in @@ -7723,11 +7691,9 @@ let (lift_tf_layered_effect : lift_ct.FStar_Syntax_Syntax.result_typ wp FStar_Compiler_Range_Type.dummyRange in ((let uu___7 = - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffects")) - && - (FStar_TypeChecker_Env.debug env - FStar_Options.Extreme) in + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffects) + && (FStar_Compiler_Debug.extreme ()) in if uu___7 then let uu___8 = diff --git a/ocaml/fstar-lib/generated/FStar_Universal.ml b/ocaml/fstar-lib/generated/FStar_Universal.ml index 34d55f874e0..20f5f331cd3 100644 --- a/ocaml/fstar-lib/generated/FStar_Universal.ml +++ b/ocaml/fstar-lib/generated/FStar_Universal.ml @@ -1375,6 +1375,8 @@ let rec (tc_fold_interleave : ((FStar_Compiler_List.op_At mods [nmod]), (FStar_Compiler_List.op_At mllibs (as_list env_before mllib)), env) remaining1))) +let (dbg_dep : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Dep" let (batch_mode_tc : Prims.string Prims.list -> FStar_Parser_Dep.deps -> @@ -1382,8 +1384,7 @@ let (batch_mode_tc : = fun filenames -> fun dep_graph -> - (let uu___1 = - FStar_Options.debug_at_level_no_module (FStar_Options.Other "Dep") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_dep in if uu___1 then (FStar_Compiler_Util.print_endline diff --git a/ocaml/fstar-tests/generated/FStar_Tests_Unif.ml b/ocaml/fstar-tests/generated/FStar_Tests_Unif.ml index 5ea2b133be9..55912cfcad9 100644 --- a/ocaml/fstar-tests/generated/FStar_Tests_Unif.ml +++ b/ocaml/fstar-tests/generated/FStar_Tests_Unif.ml @@ -289,50 +289,43 @@ let (run_all : unit -> Prims.bool) = match uu___13 with | (tm, us) -> let sol = FStar_Tests_Pars.tc "fun (x:Type0) -> Prims.pair x x" in - ((let uu___15 = - let uu___16 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Core") in - FStar_Compiler_Util.string_of_bool uu___16 in - FStar_Compiler_Util.print1 - "Processed args: debug_at_level Core? %s\n" uu___15); - unify_check (Prims.of_int (9)) [] tm sol + (unify_check (Prims.of_int (9)) [] tm sol FStar_TypeChecker_Common.Trivial - (fun uu___16 -> - let uu___17 = - let uu___18 = - let uu___19 = FStar_Compiler_List.hd us in - norm uu___19 in - let uu___19 = norm sol in - FStar_Tests_Util.term_eq uu___18 uu___19 in - FStar_Tests_Util.always (Prims.of_int (9)) uu___17); - (let uu___16 = - let uu___17 = + (fun uu___15 -> + let uu___16 = + let uu___17 = + let uu___18 = FStar_Compiler_List.hd us in + norm uu___18 in + let uu___18 = norm sol in + FStar_Tests_Util.term_eq uu___17 uu___18 in + FStar_Tests_Util.always (Prims.of_int (9)) uu___16); + (let uu___15 = + let uu___16 = FStar_Tests_Pars.tc "fun (u: int -> int -> int) (x:int) -> u x" in - inst Prims.int_one uu___17 in - match uu___16 with + inst Prims.int_one uu___16 in + match uu___15 with | (tm1, us1) -> let sol1 = FStar_Tests_Pars.tc "fun (x y:int) -> x + y" in (unify_check (Prims.of_int (10)) [] tm1 sol1 FStar_TypeChecker_Common.Trivial - (fun uu___18 -> - let uu___19 = - let uu___20 = - let uu___21 = FStar_Compiler_List.hd us1 in - norm uu___21 in - let uu___21 = norm sol1 in - FStar_Tests_Util.term_eq uu___20 uu___21 in - FStar_Tests_Util.always (Prims.of_int (10)) uu___19); + (fun uu___17 -> + let uu___18 = + let uu___19 = + let uu___20 = FStar_Compiler_List.hd us1 in + norm uu___20 in + let uu___20 = norm sol1 in + FStar_Tests_Util.term_eq uu___19 uu___20 in + FStar_Tests_Util.always (Prims.of_int (10)) uu___18); (let tm11 = FStar_Tests_Pars.tc "x:int -> y:int{eq2 y x} -> bool" in let tm2 = FStar_Tests_Pars.tc "x:int -> y:int -> bool" in - (let uu___19 = - let uu___20 = + (let uu___18 = + let uu___19 = FStar_Tests_Pars.tc "forall (x:int). (forall (y:int). y==x)" in - FStar_TypeChecker_Common.NonTrivial uu___20 in - unify1 (Prims.of_int (11)) [] tm11 tm2 uu___19); + FStar_TypeChecker_Common.NonTrivial uu___19 in + unify1 (Prims.of_int (11)) [] tm11 tm2 uu___18); (let tm12 = FStar_Tests_Pars.tc "a:Type0 -> b:(a -> Type0) -> x:a -> y:b x -> Tot Type0" in @@ -341,7 +334,7 @@ let (run_all : unit -> Prims.bool) = "a:Type0 -> b:(a -> Type0) -> x:a -> y:b x -> Tot Type0" in unify1 (Prims.of_int (12)) [] tm12 tm21 FStar_TypeChecker_Common.Trivial; - (let uu___20 = + (let uu___19 = let int_typ = FStar_Tests_Pars.tc "int" in let x1 = FStar_Syntax_Syntax.new_bv @@ -354,40 +347,40 @@ let (run_all : unit -> Prims.bool) = FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None typ in let tm13 = - let uu___21 = - let uu___22 = - let uu___23 = FStar_Syntax_Syntax.bv_to_name q in - [uu___23] in - FStar_Tests_Util.app l uu___22 in - norm uu___21 in + let uu___20 = + let uu___21 = + let uu___22 = FStar_Syntax_Syntax.bv_to_name q in + [uu___22] in + FStar_Tests_Util.app l uu___21 in + norm uu___20 in let l1 = FStar_Tests_Pars.tc "fun (p:unit -> Type0) -> p" in let unit = FStar_Tests_Pars.tc "()" in let env = - let uu___21 = FStar_Tests_Pars.init () in - let uu___22 = - let uu___23 = FStar_Syntax_Syntax.mk_binder x1 in - let uu___24 = - let uu___25 = FStar_Syntax_Syntax.mk_binder q in - [uu___25] in - uu___23 :: uu___24 in - FStar_TypeChecker_Env.push_binders uu___21 uu___22 in - let uu___21 = + let uu___20 = FStar_Tests_Pars.init () in + let uu___21 = + let uu___22 = FStar_Syntax_Syntax.mk_binder x1 in + let uu___23 = + let uu___24 = FStar_Syntax_Syntax.mk_binder q in + [uu___24] in + uu___22 :: uu___23 in + FStar_TypeChecker_Env.push_binders uu___20 uu___21 in + let uu___20 = FStar_TypeChecker_Util.new_implicit_var "" FStar_Compiler_Range_Type.dummyRange env typ in - match uu___21 with - | (u_p, uu___22, uu___23) -> + match uu___20 with + | (u_p, uu___21, uu___22) -> let tm22 = - let uu___24 = - let uu___25 = FStar_Tests_Util.app l1 [u_p] in - norm uu___25 in - FStar_Tests_Util.app uu___24 [unit] in + let uu___23 = + let uu___24 = FStar_Tests_Util.app l1 [u_p] in + norm uu___24 in + FStar_Tests_Util.app uu___23 [unit] in (tm13, tm22, [x1; q]) in - match uu___20 with + match uu___19 with | (tm13, tm22, bvs_13) -> (unify1 (Prims.of_int (13)) bvs_13 tm13 tm22 FStar_TypeChecker_Common.Trivial; - (let uu___22 = + (let uu___21 = let int_typ = FStar_Tests_Pars.tc "int" in let x1 = FStar_Syntax_Syntax.new_bv @@ -400,47 +393,47 @@ let (run_all : unit -> Prims.bool) = FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None typ in let tm14 = - let uu___23 = - let uu___24 = - let uu___25 = + let uu___22 = + let uu___23 = + let uu___24 = FStar_Syntax_Syntax.bv_to_name q in - [uu___25] in - FStar_Tests_Util.app l uu___24 in - norm uu___23 in + [uu___24] in + FStar_Tests_Util.app l uu___23 in + norm uu___22 in let l1 = FStar_Tests_Pars.tc "fun (p:pure_post unit) -> p" in let unit = FStar_Tests_Pars.tc "()" in let env = - let uu___23 = FStar_Tests_Pars.init () in - let uu___24 = - let uu___25 = + let uu___22 = FStar_Tests_Pars.init () in + let uu___23 = + let uu___24 = FStar_Syntax_Syntax.mk_binder x1 in - let uu___26 = - let uu___27 = + let uu___25 = + let uu___26 = FStar_Syntax_Syntax.mk_binder q in - [uu___27] in - uu___25 :: uu___26 in - FStar_TypeChecker_Env.push_binders uu___23 - uu___24 in - let uu___23 = + [uu___26] in + uu___24 :: uu___25 in + FStar_TypeChecker_Env.push_binders uu___22 + uu___23 in + let uu___22 = FStar_TypeChecker_Util.new_implicit_var "" FStar_Compiler_Range_Type.dummyRange env typ in - match uu___23 with - | (u_p, uu___24, uu___25) -> + match uu___22 with + | (u_p, uu___23, uu___24) -> let tm23 = - let uu___26 = - let uu___27 = + let uu___25 = + let uu___26 = FStar_Tests_Util.app l1 [u_p] in - norm uu___27 in - FStar_Tests_Util.app uu___26 [unit] in + norm uu___26 in + FStar_Tests_Util.app uu___25 [unit] in (tm14, tm23, [x1; q]) in - match uu___22 with + match uu___21 with | (tm14, tm23, bvs_14) -> (unify1 (Prims.of_int (14)) bvs_14 tm14 tm23 FStar_TypeChecker_Common.Trivial; - (let uu___24 = + (let uu___23 = FStar_Tests_Pars.pars_and_tc_fragment "let ty0 n = x:int { x >= n }\nlet ty1 n = x:ty0 n { x > n }\nassume val tc (t:Type0) : Type0"; (let t0 = FStar_Tests_Pars.tc "ty1 17" in @@ -448,11 +441,11 @@ let (run_all : unit -> Prims.bool) = FStar_Tests_Pars.tc "x:ty0 17 { x > 17 }" in (t0, t1)) in - match uu___24 with + match uu___23 with | (tm15, tm24) -> (check_core (Prims.of_int (15)) false false tm15 tm24; - (let uu___26 = + (let uu___25 = let t0 = FStar_Tests_Pars.tc "x:int { x >= 17 /\\ x > 17 }" in @@ -460,11 +453,11 @@ let (run_all : unit -> Prims.bool) = FStar_Tests_Pars.tc "x:ty0 17 { x > 17 }" in (t0, t1) in - match uu___26 with + match uu___25 with | (tm16, tm25) -> (check_core (Prims.of_int (16)) false false tm16 tm25; - (let uu___28 = + (let uu___27 = FStar_Tests_Pars.pars_and_tc_fragment "let defn17_0 (x:nat) : nat -> nat -> Type0 = fun y z -> a:int { a + x == y + z }"; (let t0 = @@ -486,12 +479,12 @@ let (run_all : unit -> Prims.bool) = FStar_Pervasives_Native.None)] t0.FStar_Syntax_Syntax.pos in (t0, t1)) in - match uu___28 with + match uu___27 with | (tm17, tm26) -> (check_core (Prims.of_int (17)) false false tm17 tm26; - (let uu___30 = + (let uu___29 = let t0 = FStar_Tests_Pars.tc "dp:((dtuple2 int (fun (y:int) -> z:int{ z > y })) <: Type0) { let (| x, _ |) = dp in x > 17 }" in @@ -499,13 +492,13 @@ let (run_all : unit -> Prims.bool) = FStar_Tests_Pars.tc "(dtuple2 int (fun (y:int) -> z:int{ z > y }))" in (t0, t1) in - match uu___30 with + match uu___29 with | (tm18, tm27) -> (check_core (Prims.of_int (18)) true false tm18 tm27; - (let uu___32 = + (let uu___31 = FStar_Tests_Pars.pars_and_tc_fragment "type vprop' = { t:Type0 ; n:nat }"; (let t0 = @@ -515,13 +508,13 @@ let (run_all : unit -> Prims.bool) = FStar_Tests_Pars.tc "x:bool{ x == false }" in (t0, t1)) in - match uu___32 with + match uu___31 with | (tm19, tm28) -> (check_core (Prims.of_int (19)) false false tm19 tm28; - (let uu___34 + (let uu___33 = let t0 = FStar_Tests_Pars.tc @@ -530,7 +523,7 @@ let (run_all : unit -> Prims.bool) = FStar_Tests_Pars.tc "j:(i:nat{ i > 17 } <: Type0){j > 42}" in (t0, t1) in - match uu___34 + match uu___33 with | (tm110, tm29) -> @@ -539,7 +532,7 @@ let (run_all : unit -> Prims.bool) = true true tm110 tm29; - (let uu___36 + (let uu___35 = FStar_Tests_Pars.pars_and_tc_fragment "assume val tstr21 (x:string) : Type0"; @@ -551,7 +544,7 @@ let (run_all : unit -> Prims.bool) = FStar_Tests_Pars.tc "bool -> int -> tstr21 \"hello\" -> bool" in (t0, ty)) in - match uu___36 + match uu___35 with | (tm3, ty) @@ -561,12 +554,12 @@ let (run_all : unit -> Prims.bool) = tm3 ty; FStar_Options.__clear_unit_tests (); - (let uu___40 + (let uu___39 = FStar_Compiler_Effect.op_Bang success in if - uu___40 + uu___39 then FStar_Compiler_Util.print_string "Unifier ok\n" From 3f7f11caa04ee5a76557bfda6c03bb554a300249 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 29 Apr 2024 08:37:01 -0700 Subject: [PATCH 143/239] Update expected output --- tests/ide/emacs/fstarmode_gh73.out.expected | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/ide/emacs/fstarmode_gh73.out.expected b/tests/ide/emacs/fstarmode_gh73.out.expected index 60ea334151f..1daf84fb1d4 100644 --- a/tests/ide/emacs/fstarmode_gh73.out.expected +++ b/tests/ide/emacs/fstarmode_gh73.out.expected @@ -1,5 +1,5 @@ {"kind": "protocol-info", "rest": "[...]"} -{"kind": "response", "query-id": "1", "response": [{"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [135, 17], "end": [135, 24], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [136, 22], "end": [136, 29], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Adding an implicit 'assume new' qualifier on document\n", "number": 239, "ranges": [{"beg": [36, 5], "end": [36, 13], "fname": "FStar.Stubs.Pprint.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [624, 15], "end": [624, 22], "fname": "FStar.Tactics.V2.Derived.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [176, 11], "end": [176, 18], "fname": "FStar.Tactics.V2.Logic.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Pattern uses these theory symbols or terms that should not be in an smt pattern: Prims.op_Subtraction\n", "number": 271, "ranges": [{"beg": [434, 8], "end": [434, 51], "fname": "FStar.UInt.fsti"}]}], "status": "success"} +{"kind": "response", "query-id": "1", "response": [{"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [135, 17], "end": [135, 24], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [136, 22], "end": [136, 29], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Adding an implicit 'assume new' qualifier on document\n", "number": 239, "ranges": [{"beg": [36, 5], "end": [36, 13], "fname": "FStar.Stubs.Pprint.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [623, 15], "end": [623, 22], "fname": "FStar.Tactics.V2.Derived.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [176, 11], "end": [176, 18], "fname": "FStar.Tactics.V2.Logic.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Pattern uses these theory symbols or terms that should not be in an smt pattern: Prims.op_Subtraction\n", "number": 271, "ranges": [{"beg": [434, 8], "end": [434, 51], "fname": "FStar.UInt.fsti"}]}], "status": "success"} {"kind": "response", "query-id": "2", "response": [{"level": "error", "message": " - Expected expression of type int got expression \"A\" of type string\n", "number": 189, "ranges": [{"beg": [4, 48], "end": [4, 51], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "3", "response": [{"level": "error", "message": " - Expected expression of type int got expression \"A\" of type string\n", "number": 189, "ranges": [{"beg": [4, 48], "end": [4, 51], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "4", "response": [], "status": "success"} From 596cc5c35c8eb458e32f74c630c006e4c78b218f Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Mon, 29 Apr 2024 11:07:51 -0700 Subject: [PATCH 144/239] another test --- tests/bug-reports/BugBoxInjectivity.fst | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/bug-reports/BugBoxInjectivity.fst b/tests/bug-reports/BugBoxInjectivity.fst index 11639740730..538de27e266 100644 --- a/tests/bug-reports/BugBoxInjectivity.fst +++ b/tests/bug-reports/BugBoxInjectivity.fst @@ -89,6 +89,10 @@ noeq type test3 (a:idx) : Type u#1 = | Mk3 : test3 a +[@@expect_failure] +let eq_test3_should_fail (x0 : test3 A1) (x1 : test3 A2) : unit = + assert (test3 A1 == test3 A2) + let case0 (x0 : test3 A1) (x1 : test3 A2) : Lemma False = assume (test3 A1 == test3 A2); assume (~ (Mk3 #A1 == coerce_eq () (Mk3 #A2))) From b98af595e873c2df5d6d41fa01e253e7906a1154 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 29 Apr 2024 13:30:24 -0700 Subject: [PATCH 145/239] Typeclasses: some optimization Look up sigelt and fundeps only once --- ulib/FStar.Tactics.Typeclasses.fst | 40 ++++++++++++++++++------------ 1 file changed, 24 insertions(+), 16 deletions(-) diff --git a/ulib/FStar.Tactics.Typeclasses.fst b/ulib/FStar.Tactics.Typeclasses.fst index 15d4eedc900..88a4898aa99 100644 --- a/ulib/FStar.Tactics.Typeclasses.fst +++ b/ulib/FStar.Tactics.Typeclasses.fst @@ -59,11 +59,21 @@ type st_t = { noeq type tc_goal = { - g : term; - head_fv : fv; + g : term; + (* ^ The goal as a term *) + head_fv : fv; + (* ^ Head fv of goal (g), i.e. the class name *) + c_se : option sigelt; + (* ^ Class sigelt *) + fundeps : option (list int); + (* ^ Functional dependendcies of class, if any. *) args_and_uvars : list (argv & bool); + (* ^ The arguments of the goal, and whether they are + unresolved, even partially. I.e. the boolean is true + when the arg contains uvars. *) } + val fv_eq : fv -> fv -> Tot bool let fv_eq fv1 fv2 = let n1 = inspect_fv fv1 in @@ -148,7 +158,7 @@ let rec unembed_list (#a:Type) (u : term -> Tac (option a)) (t:term) : Tac (opti | _ -> None -let extract_fundep (se : sigelt) : Tac (option (list int)) = +let extract_fundeps (se : sigelt) : Tac (option (list int)) = let attrs = sigelt_attrs se in let rec aux (attrs : list term) : Tac (option (list int)) = match attrs with @@ -166,14 +176,6 @@ let extract_fundep (se : sigelt) : Tac (option (list int)) = aux attrs let trywith (st:st_t) (g:tc_goal) (t typ : term) (k : st_t -> Tac unit) : Tac unit = - (* Class sigelt *) - let c_se = lookup_typ (cur_env()) (inspect_fv g.head_fv) in - let fundeps = - match c_se with - | Some se -> - extract_fundep se - | None -> None - in // print ("head_fv = " ^ fv_to_string g.head_fv); // print ("fundeps = " ^ Util.string_of_option (Util.string_of_list (fun i -> string_of_int i)) fundeps); let unresolved_args = g.args_and_uvars |> Util.mapi (fun i (_, b) -> if b then [i <: int] else []) |> List.Tot.flatten in @@ -188,10 +190,10 @@ let trywith (st:st_t) (g:tc_goal) (t typ : term) (k : st_t -> Tac unit) : Tac un raise NoInst; // class mismatch, would be better to not even get here debug (fun () -> "Trying to apply hypothesis/instance: " ^ term_to_string t); (fun () -> - if Cons? unresolved_args && None? fundeps then + if Cons? unresolved_args && None? g.fundeps then fail "Will not continue as there are unresolved args (and no fundeps)" - else if Cons? unresolved_args && Some? fundeps then ( - let Some fundeps = fundeps in + else if Cons? unresolved_args && Some? g.fundeps then ( + let Some fundeps = g.fundeps in debug (fun () -> "checking fundeps"); let all_good = List.Tot.for_all (fun i -> List.Tot.mem i fundeps) unresolved_args in if all_good then apply t else fail "fundeps" @@ -248,10 +250,16 @@ let rec tcresolve' (st:st_t) : Tac unit = raise NoInst | Some (head_fv, us, args) -> - let args_and_uvars = args |> Util.map (fun (a, q) -> (a, q), Cons? (free_uvars a )) in (* ^ Maybe should check is this really is a class too? *) + let c_se = lookup_typ (cur_env ()) (inspect_fv head_fv) in + let fundeps = match c_se with + | None -> None + | Some se -> extract_fundeps se + in + + let args_and_uvars = args |> Util.map (fun (a, q) -> (a, q), Cons? (free_uvars a )) in let st = { st with seen = g :: st.seen } in - let g = { g = g; head_fv = head_fv; args_and_uvars = args_and_uvars } in + let g = { g; head_fv; c_se; fundeps; args_and_uvars } in local st g tcresolve' `or_else` global st g tcresolve' let rec concatMap (f : 'a -> Tac (list 'b)) (l : list 'a) : Tac (list 'b) = From b18cbb486bd76aef27babdd511520dee1e222052 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 29 Apr 2024 13:31:19 -0700 Subject: [PATCH 146/239] Disable a debug flag --- tests/typeclasses/Bug3130.fst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/typeclasses/Bug3130.fst b/tests/typeclasses/Bug3130.fst index 12363926fad..4489041616b 100644 --- a/tests/typeclasses/Bug3130.fst +++ b/tests/typeclasses/Bug3130.fst @@ -22,7 +22,7 @@ assume val truc: open FStar.Tactics.Typeclasses -#set-options "--debug Low" +//#set-options "--debug Low" noeq type machin (a:Type) (d : typeclass2 bytes #solve a) (content:a) = { From 09fbffe818bae17782c16a9f15d5399cec27ac18 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 29 Apr 2024 14:41:36 -0700 Subject: [PATCH 147/239] Typeclasses: some error message tweaks --- ulib/FStar.Tactics.Typeclasses.fst | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/ulib/FStar.Tactics.Typeclasses.fst b/ulib/FStar.Tactics.Typeclasses.fst index 88a4898aa99..d6b21d4199d 100644 --- a/ulib/FStar.Tactics.Typeclasses.fst +++ b/ulib/FStar.Tactics.Typeclasses.fst @@ -220,15 +220,9 @@ let global (st:st_t) (g:tc_goal) (k : st_t -> Tac unit) () : Tac unit = st.glb (* - tcresolve': the main typeclass instantiation function. + tcresolve': the main typeclass instantiation function. - seen : a list of goals we've seen already in this path of the search, - used to prevent loops - glb : a list of all global instances in scope, for all classes - fuel : amount of steps we allow in this path, we stop if we reach zero - head_fv : the head of the goal we're trying to solve, i.e. the class name - - TODO: some form of memoization + It mostly creates a tc_goal record and calls the functions above. *) let rec tcresolve' (st:st_t) : Tac unit = if st.fuel <= 0 then @@ -269,15 +263,17 @@ let rec concatMap (f : 'a -> Tac (list 'b)) (l : list 'a) : Tac (list 'b) = [@@plugin] let tcresolve () : Tac unit = + let open FStar.Stubs.Pprint in debug (fun () -> dump ""; "tcresolve entry point"); let w = cur_witness () in + set_dump_on_failure false; (* We report our own errors *) // Not using intros () directly, since that unfolds aggressively if the term is not a literal arrow maybe_intros (); // Fetch a list of all instances in scope right now. // TODO: turn this into a hash map per class, ideally one that can be - // stored. + // persisted across calss. let glb = lookup_attr_ses (`tcinstance) (cur_env ()) in let glb = glb |> concatMap (fun se -> sigelt_name se |> concatMap (fun fv -> [(se, fv)]) @@ -295,6 +291,7 @@ let tcresolve () : Tac unit = | NoInst -> let open FStar.Stubs.Pprint in fail_doc [ + text "Typeclass resolution failed"; prefix 2 1 (text "Could not solve constraint") (arbitrary_string (term_to_string (cur_goal ()))); ] From 6b37f25073934012db235e6582c98426b84bb88f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 29 Apr 2024 14:44:15 -0700 Subject: [PATCH 148/239] snap --- .../generated/FStar_Tactics_Typeclasses.ml | 1794 +++++++++-------- 1 file changed, 928 insertions(+), 866 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml index 4d82c641815..2017531fc3e 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml @@ -68,18 +68,33 @@ type tc_goal = { g: FStar_Tactics_NamedView.term ; head_fv: FStar_Reflection_Types.fv ; + c_se: FStar_Reflection_Types.sigelt FStar_Pervasives_Native.option ; + fundeps: Prims.int Prims.list FStar_Pervasives_Native.option ; args_and_uvars: (FStar_Reflection_V2_Data.argv * Prims.bool) Prims.list } let (__proj__Mktc_goal__item__g : tc_goal -> FStar_Tactics_NamedView.term) = fun projectee -> - match projectee with | { g; head_fv; args_and_uvars;_} -> g + match projectee with + | { g; head_fv; c_se; fundeps; args_and_uvars;_} -> g let (__proj__Mktc_goal__item__head_fv : tc_goal -> FStar_Reflection_Types.fv) = fun projectee -> - match projectee with | { g; head_fv; args_and_uvars;_} -> head_fv + match projectee with + | { g; head_fv; c_se; fundeps; args_and_uvars;_} -> head_fv +let (__proj__Mktc_goal__item__c_se : + tc_goal -> FStar_Reflection_Types.sigelt FStar_Pervasives_Native.option) = + fun projectee -> + match projectee with + | { g; head_fv; c_se; fundeps; args_and_uvars;_} -> c_se +let (__proj__Mktc_goal__item__fundeps : + tc_goal -> Prims.int Prims.list FStar_Pervasives_Native.option) = + fun projectee -> + match projectee with + | { g; head_fv; c_se; fundeps; args_and_uvars;_} -> fundeps let (__proj__Mktc_goal__item__args_and_uvars : tc_goal -> (FStar_Reflection_V2_Data.argv * Prims.bool) Prims.list) = fun projectee -> - match projectee with | { g; head_fv; args_and_uvars;_} -> args_and_uvars + match projectee with + | { g; head_fv; c_se; fundeps; args_and_uvars;_} -> args_and_uvars let (fv_eq : FStar_Reflection_Types.fv -> FStar_Reflection_Types.fv -> Prims.bool) = fun fv1 -> @@ -96,12 +111,12 @@ let rec (head_of : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (76)) (Prims.of_int (8)) (Prims.of_int (76)) + (Prims.of_int (86)) (Prims.of_int (8)) (Prims.of_int (86)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (76)) (Prims.of_int (2)) (Prims.of_int (80)) + (Prims.of_int (86)) (Prims.of_int (2)) (Prims.of_int (90)) (Prims.of_int (13))))) (Obj.magic (FStar_Tactics_NamedView.inspect t)) (fun uu___ -> @@ -136,12 +151,12 @@ let (hua : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (83)) (Prims.of_int (17)) (Prims.of_int (83)) + (Prims.of_int (93)) (Prims.of_int (17)) (Prims.of_int (93)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (82)) (Prims.of_int (62)) (Prims.of_int (87)) + (Prims.of_int (92)) (Prims.of_int (62)) (Prims.of_int (97)) (Prims.of_int (13))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_app t)) (fun uu___ -> @@ -154,14 +169,14 @@ let (hua : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (84)) (Prims.of_int (8)) - (Prims.of_int (84)) (Prims.of_int (18))))) + (Prims.of_int (94)) (Prims.of_int (8)) + (Prims.of_int (94)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (84)) (Prims.of_int (2)) - (Prims.of_int (87)) (Prims.of_int (13))))) + (Prims.of_int (94)) (Prims.of_int (2)) + (Prims.of_int (97)) (Prims.of_int (13))))) (Obj.magic (FStar_Tactics_NamedView.inspect hd)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -182,12 +197,12 @@ let rec (res_typ : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (90)) (Prims.of_int (8)) (Prims.of_int (90)) + (Prims.of_int (100)) (Prims.of_int (8)) (Prims.of_int (100)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (90)) (Prims.of_int (2)) (Prims.of_int (96)) + (Prims.of_int (100)) (Prims.of_int (2)) (Prims.of_int (106)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_NamedView.inspect t)) (fun uu___ -> @@ -233,12 +248,12 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (111)) (Prims.of_int (10)) (Prims.of_int (111)) + (Prims.of_int (121)) (Prims.of_int (10)) (Prims.of_int (121)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (112)) (Prims.of_int (2)) (Prims.of_int (116)) + (Prims.of_int (122)) (Prims.of_int (2)) (Prims.of_int (126)) (Prims.of_int (11))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_goal ())) (fun uu___1 -> @@ -248,13 +263,13 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (112)) (Prims.of_int (8)) - (Prims.of_int (112)) (Prims.of_int (17))))) + (Prims.of_int (122)) (Prims.of_int (8)) + (Prims.of_int (122)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (112)) (Prims.of_int (2)) - (Prims.of_int (116)) (Prims.of_int (11))))) + (Prims.of_int (122)) (Prims.of_int (2)) + (Prims.of_int (126)) (Prims.of_int (11))))) (Obj.magic (FStar_Tactics_NamedView.inspect g)) (fun uu___1 -> (fun uu___1 -> @@ -267,17 +282,17 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (114)) + (Prims.of_int (124)) (Prims.of_int (4)) - (Prims.of_int (114)) + (Prims.of_int (124)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (115)) + (Prims.of_int (125)) (Prims.of_int (4)) - (Prims.of_int (115)) + (Prims.of_int (125)) (Prims.of_int (19))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -285,17 +300,17 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (114)) + (Prims.of_int (124)) (Prims.of_int (11)) - (Prims.of_int (114)) + (Prims.of_int (124)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (114)) + (Prims.of_int (124)) (Prims.of_int (4)) - (Prims.of_int (114)) + (Prims.of_int (124)) (Prims.of_int (21))))) (Obj.magic (FStar_Tactics_V2_Builtins.intro @@ -354,12 +369,12 @@ let rec unembed_list : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (135)) (Prims.of_int (8)) (Prims.of_int (135)) + (Prims.of_int (145)) (Prims.of_int (8)) (Prims.of_int (145)) (Prims.of_int (13))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (135)) (Prims.of_int (2)) (Prims.of_int (149)) + (Prims.of_int (145)) (Prims.of_int (2)) (Prims.of_int (159)) (Prims.of_int (8))))) (Obj.magic (hua t)) (fun uu___ -> (fun uu___ -> @@ -383,17 +398,17 @@ let rec unembed_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (138)) + (Prims.of_int (148)) (Prims.of_int (12)) - (Prims.of_int (138)) + (Prims.of_int (148)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (138)) + (Prims.of_int (148)) (Prims.of_int (6)) - (Prims.of_int (140)) + (Prims.of_int (150)) (Prims.of_int (17))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -401,17 +416,17 @@ let rec unembed_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (138)) + (Prims.of_int (148)) (Prims.of_int (12)) - (Prims.of_int (138)) + (Prims.of_int (148)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (138)) + (Prims.of_int (148)) (Prims.of_int (12)) - (Prims.of_int (138)) + (Prims.of_int (148)) (Prims.of_int (35))))) (Obj.magic (u hd)) (fun uu___2 -> @@ -422,17 +437,17 @@ let rec unembed_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (138)) + (Prims.of_int (148)) (Prims.of_int (18)) - (Prims.of_int (138)) + (Prims.of_int (148)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (138)) + (Prims.of_int (148)) (Prims.of_int (12)) - (Prims.of_int (138)) + (Prims.of_int (148)) (Prims.of_int (35))))) (Obj.magic (unembed_list u tl)) @@ -475,7 +490,7 @@ let rec unembed_list : (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> FStar_Pervasives_Native.None)))) uu___) -let (extract_fundep : +let (extract_fundeps : FStar_Reflection_Types.sigelt -> (Prims.int Prims.list FStar_Pervasives_Native.option, unit) FStar_Tactics_Effect.tac_repr) @@ -485,12 +500,12 @@ let (extract_fundep : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (152)) (Prims.of_int (14)) (Prims.of_int (152)) + (Prims.of_int (162)) (Prims.of_int (14)) (Prims.of_int (162)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (152)) (Prims.of_int (32)) (Prims.of_int (166)) + (Prims.of_int (162)) (Prims.of_int (32)) (Prims.of_int (176)) (Prims.of_int (13))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Reflection_V2_Builtins.sigelt_attrs se)) @@ -512,17 +527,17 @@ let (extract_fundep : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (157)) + (Prims.of_int (167)) (Prims.of_int (12)) - (Prims.of_int (157)) + (Prims.of_int (167)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (157)) + (Prims.of_int (167)) (Prims.of_int (12)) - (Prims.of_int (157)) + (Prims.of_int (167)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_app @@ -568,247 +583,159 @@ let (trywith : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (170)) (Prims.of_int (15)) - (Prims.of_int (170)) (Prims.of_int (60))))) + (Prims.of_int (181)) (Prims.of_int (26)) + (Prims.of_int (181)) (Prims.of_int (122))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (170)) (Prims.of_int (63)) - (Prims.of_int (204)) (Prims.of_int (13))))) + (Prims.of_int (184)) (Prims.of_int (4)) + (Prims.of_int (206)) (Prims.of_int (13))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (170)) (Prims.of_int (26)) - (Prims.of_int (170)) (Prims.of_int (37))))) + (Prims.of_int (181)) (Prims.of_int (26)) + (Prims.of_int (181)) (Prims.of_int (102))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (170)) (Prims.of_int (15)) - (Prims.of_int (170)) (Prims.of_int (60))))) - (Obj.magic (FStar_Tactics_V2_Derived.cur_env ())) + (Prims.of_int (181)) (Prims.of_int (26)) + (Prims.of_int (181)) (Prims.of_int (122))))) + (Obj.magic + (FStar_Tactics_Util.mapi + (fun uu___1 -> + fun uu___ -> + (fun i -> + fun uu___ -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___1 -> + match uu___ with + | (uu___2, b) -> + if b then [i] else []))) + uu___1 uu___) g.args_and_uvars)) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_Reflection_V2_Builtins.lookup_typ uu___ - (FStar_Reflection_V2_Builtins.inspect_fv - g.head_fv))))) + (fun uu___1 -> FStar_List_Tot_Base.flatten uu___)))) (fun uu___ -> - (fun c_se -> + (fun unresolved_args -> Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (172)) (Prims.of_int (6)) - (Prims.of_int (175)) (Prims.of_int (20))))) + (Prims.of_int (184)) (Prims.of_int (10)) + (Prims.of_int (184)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (176)) (Prims.of_int (6)) - (Prims.of_int (204)) (Prims.of_int (13))))) - (match c_se with - | FStar_Pervasives_Native.Some se -> - Obj.magic (Obj.repr (extract_fundep se)) - | FStar_Pervasives_Native.None -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - FStar_Pervasives_Native.None)))) + (Prims.of_int (184)) (Prims.of_int (4)) + (Prims.of_int (206)) (Prims.of_int (13))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (184)) + (Prims.of_int (18)) + (Prims.of_int (184)) + (Prims.of_int (31))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (184)) + (Prims.of_int (10)) + (Prims.of_int (184)) + (Prims.of_int (31))))) + (Obj.magic (res_typ typ)) + (fun uu___ -> + (fun uu___ -> Obj.magic (head_of uu___)) + uu___))) (fun uu___ -> - (fun fundeps -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (179)) - (Prims.of_int (26)) - (Prims.of_int (179)) - (Prims.of_int (122))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (182)) - (Prims.of_int (4)) - (Prims.of_int (204)) - (Prims.of_int (13))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (179)) - (Prims.of_int (26)) - (Prims.of_int (179)) - (Prims.of_int (102))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (179)) - (Prims.of_int (26)) - (Prims.of_int (179)) - (Prims.of_int (122))))) - (Obj.magic - (FStar_Tactics_Util.mapi - (fun uu___1 -> - fun uu___ -> - (fun i -> - fun uu___ -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - match uu___ - with - | (uu___2, - b) -> - if b - then [i] - else []))) - uu___1 uu___) - g.args_and_uvars)) - (fun uu___ -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_List_Tot_Base.flatten - uu___)))) - (fun uu___ -> - (fun unresolved_args -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (182)) - (Prims.of_int (10)) - (Prims.of_int (182)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (182)) - (Prims.of_int (4)) - (Prims.of_int (204)) - (Prims.of_int (13))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (182)) - (Prims.of_int (18)) - (Prims.of_int (182)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (182)) - (Prims.of_int (10)) - (Prims.of_int (182)) - (Prims.of_int (31))))) - (Obj.magic (res_typ typ)) - (fun uu___ -> - (fun uu___ -> - Obj.magic - (head_of uu___)) - uu___))) - (fun uu___ -> - (fun uu___ -> - match uu___ with - | FStar_Pervasives_Native.None - -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - ( - FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (184)) - (Prims.of_int (6)) - (Prims.of_int (184)) - (Prims.of_int (104))))) - (FStar_Sealed.seal - (Obj.magic - ( - FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (185)) - (Prims.of_int (6)) - (Prims.of_int (185)) - (Prims.of_int (18))))) - (Obj.magic - (debug + (fun uu___ -> + match uu___ with + | FStar_Pervasives_Native.None -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (186)) + (Prims.of_int (6)) + (Prims.of_int (186)) + (Prims.of_int (104))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (187)) + (Prims.of_int (6)) + (Prims.of_int (187)) + (Prims.of_int (18))))) + (Obj.magic + (debug + (fun uu___1 -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (186)) + (Prims.of_int (53)) + (Prims.of_int (186)) + (Prims.of_int (103))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "prims.fst" + (Prims.of_int (590)) + (Prims.of_int (19)) + (Prims.of_int (590)) + (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (186)) + (Prims.of_int (53)) + (Prims.of_int (186)) + (Prims.of_int (69))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (186)) + (Prims.of_int (53)) + (Prims.of_int (186)) + (Prims.of_int (103))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string + t)) + (fun uu___2 -> + (fun uu___2 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind ( - fun - uu___1 -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (184)) - (Prims.of_int (53)) - (Prims.of_int (184)) - (Prims.of_int (103))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "prims.fst" - (Prims.of_int (590)) - (Prims.of_int (19)) - (Prims.of_int (590)) - (Prims.of_int (31))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal + FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (184)) - (Prims.of_int (53)) - (Prims.of_int (184)) - (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (184)) - (Prims.of_int (53)) - (Prims.of_int (184)) - (Prims.of_int (103))))) - (Obj.magic - (FStar_Tactics_V2_Builtins.term_to_string - t)) - (fun - uu___2 -> - (fun - uu___2 -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (184)) + (Prims.of_int (186)) (Prims.of_int (72)) - (Prims.of_int (184)) + (Prims.of_int (186)) (Prims.of_int (103))))) - (FStar_Sealed.seal + ( + FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "prims.fst" @@ -816,15 +743,16 @@ let (trywith : (Prims.of_int (19)) (Prims.of_int (590)) (Prims.of_int (31))))) - (Obj.magic + ( + Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (184)) + (Prims.of_int (186)) (Prims.of_int (85)) - (Prims.of_int (184)) + (Prims.of_int (186)) (Prims.of_int (103))))) (FStar_Sealed.seal (Obj.magic @@ -845,7 +773,8 @@ let (trywith : Prims.strcat " typ=" uu___3)))) - (fun + ( + fun uu___3 -> FStar_Tactics_Effect.lift_div_tac (fun @@ -853,121 +782,107 @@ let (trywith : Prims.strcat uu___2 uu___3)))) - uu___2))) - (fun - uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___3 -> - Prims.strcat - "no head for typ of this? " - uu___2))))) - (fun uu___1 -> - FStar_Tactics_Effect.raise - NoInst)) - | FStar_Pervasives_Native.Some - fv' -> - Obj.magic - (FStar_Tactics_Effect.tac_bind + uu___2))) + (fun uu___2 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> + Prims.strcat + "no head for typ of this? " + uu___2))))) + (fun uu___1 -> + FStar_Tactics_Effect.raise NoInst)) + | FStar_Pervasives_Native.Some fv' -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (189)) + (Prims.of_int (6)) + (Prims.of_int (190)) + (Prims.of_int (20))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (191)) + (Prims.of_int (6)) + (Prims.of_int (206)) + (Prims.of_int (13))))) + (if + Prims.op_Negation + (fv_eq fv' g.head_fv) + then + FStar_Tactics_Effect.raise NoInst + else + FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> ())) + (fun uu___1 -> + (fun uu___1 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (191)) + (Prims.of_int (6)) + (Prims.of_int (191)) + (Prims.of_int (82))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (192)) + (Prims.of_int (6)) + (Prims.of_int (206)) + (Prims.of_int (13))))) + (Obj.magic + (debug + (fun uu___2 -> + FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic ( FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (187)) - (Prims.of_int (6)) - (Prims.of_int (188)) - (Prims.of_int (20))))) + (Prims.of_int (191)) + (Prims.of_int (65)) + (Prims.of_int (191)) + (Prims.of_int (81))))) (FStar_Sealed.seal (Obj.magic ( FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (189)) - (Prims.of_int (6)) - (Prims.of_int (204)) - (Prims.of_int (13))))) - (if - Prims.op_Negation - (fv_eq fv' - g.head_fv) - then - FStar_Tactics_Effect.raise - NoInst - else - FStar_Tactics_Effect.lift_div_tac - (fun - uu___2 -> - ())) - (fun uu___1 -> - (fun uu___1 - -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (189)) - (Prims.of_int (6)) - (Prims.of_int (189)) - (Prims.of_int (82))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (190)) - (Prims.of_int (6)) - (Prims.of_int (204)) - (Prims.of_int (13))))) - (Obj.magic - (debug - (fun - uu___2 -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (189)) - (Prims.of_int (65)) - (Prims.of_int (189)) - (Prims.of_int (81))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "prims.fst" (Prims.of_int (590)) (Prims.of_int (19)) (Prims.of_int (590)) (Prims.of_int (31))))) - (Obj.magic - (FStar_Tactics_V2_Builtins.term_to_string + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string t)) - (fun - uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun + (fun uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> Prims.strcat "Trying to apply hypothesis/instance: " uu___3))))) - (fun - uu___2 -> - (fun - uu___2 -> - Obj.magic - (FStar_Tactics_V2_Derived.seq - (fun - uu___3 -> - (fun - uu___3 -> + (fun uu___2 -> + (fun uu___2 -> + Obj.magic + (FStar_Tactics_V2_Derived.seq + (fun uu___3 -> + (fun uu___3 + -> if (Prims.uu___is_Cons unresolved_args) && (FStar_Pervasives_Native.uu___is_None - fundeps) + g.fundeps) then Obj.magic (Obj.repr @@ -981,29 +896,29 @@ let (trywith : unresolved_args) && (FStar_Pervasives_Native.uu___is_Some - fundeps) + g.fundeps) then FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (194)) + (Prims.of_int (196)) (Prims.of_int (29)) - (Prims.of_int (194)) - (Prims.of_int (36))))) + (Prims.of_int (196)) + (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (193)) - (Prims.of_int (60)) - (Prims.of_int (198)) + (Prims.of_int (195)) + (Prims.of_int (62)) + (Prims.of_int (200)) (Prims.of_int (9))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___5 -> - fundeps)) + g.fundeps)) (fun uu___5 -> (fun @@ -1012,7 +927,7 @@ let (trywith : with | FStar_Pervasives_Native.Some - fundeps1 + fundeps -> Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1020,17 +935,17 @@ let (trywith : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (195)) + (Prims.of_int (197)) (Prims.of_int (10)) - (Prims.of_int (195)) + (Prims.of_int (197)) (Prims.of_int (46))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (195)) - (Prims.of_int (47)) (Prims.of_int (197)) + (Prims.of_int (47)) + (Prims.of_int (199)) (Prims.of_int (54))))) (Obj.magic (debug @@ -1054,17 +969,17 @@ let (trywith : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (196)) + (Prims.of_int (198)) (Prims.of_int (25)) - (Prims.of_int (196)) + (Prims.of_int (198)) (Prims.of_int (91))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (197)) + (Prims.of_int (199)) (Prims.of_int (10)) - (Prims.of_int (197)) + (Prims.of_int (199)) (Prims.of_int (54))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -1072,8 +987,7 @@ let (trywith : FStar_List_Tot_Base.for_all (fun i -> FStar_List_Tot_Base.mem - i - fundeps1) + i fundeps) unresolved_args)) (fun uu___7 -> @@ -1098,27 +1012,26 @@ let (trywith : else FStar_Tactics_V2_Derived.apply_noinst t))) - uu___3) - (fun - uu___3 -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal + uu___3) + (fun uu___3 -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (202)) + (Prims.of_int (204)) (Prims.of_int (8)) - (Prims.of_int (202)) + (Prims.of_int (204)) (Prims.of_int (67))))) - (FStar_Sealed.seal + (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (202)) - (Prims.of_int (68)) (Prims.of_int (204)) + (Prims.of_int (68)) + (Prims.of_int (206)) (Prims.of_int (12))))) - (Obj.magic + (Obj.magic (debug (fun uu___4 -> @@ -1127,17 +1040,17 @@ let (trywith : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (202)) + (Prims.of_int (204)) (Prims.of_int (25)) - (Prims.of_int (202)) + (Prims.of_int (204)) (Prims.of_int (36))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (202)) + (Prims.of_int (204)) (Prims.of_int (38)) - (Prims.of_int (202)) + (Prims.of_int (204)) (Prims.of_int (66))))) (Obj.magic (FStar_Tactics_V2_Builtins.dump @@ -1148,7 +1061,7 @@ let (trywith : (fun uu___6 -> "apply seems to have worked"))))) - (fun + (fun uu___4 -> (fun uu___4 -> @@ -1158,17 +1071,17 @@ let (trywith : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (203)) + (Prims.of_int (205)) (Prims.of_int (19)) - (Prims.of_int (203)) + (Prims.of_int (205)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (204)) + (Prims.of_int (206)) (Prims.of_int (8)) - (Prims.of_int (204)) + (Prims.of_int (206)) (Prims.of_int (12))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -1191,10 +1104,8 @@ let (trywith : (k st1)) uu___5))) uu___4)))) - uu___2))) - uu___1))) - uu___))) uu___))) uu___))) - uu___) + uu___2))) uu___1))) + uu___))) uu___) let (local : st_t -> tc_goal -> @@ -1209,13 +1120,13 @@ let (local : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (207)) (Prims.of_int (4)) - (Prims.of_int (207)) (Prims.of_int (59))))) + (Prims.of_int (209)) (Prims.of_int (4)) + (Prims.of_int (209)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (207)) (Prims.of_int (60)) - (Prims.of_int (211)) (Prims.of_int (12))))) + (Prims.of_int (209)) (Prims.of_int (60)) + (Prims.of_int (213)) (Prims.of_int (12))))) (Obj.magic (debug (fun uu___1 -> @@ -1224,8 +1135,8 @@ let (local : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (207)) (Prims.of_int (40)) - (Prims.of_int (207)) (Prims.of_int (58))))) + (Prims.of_int (209)) (Prims.of_int (40)) + (Prims.of_int (209)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "prims.fst" @@ -1245,31 +1156,31 @@ let (local : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (208)) (Prims.of_int (13)) - (Prims.of_int (208)) (Prims.of_int (37))))) + (Prims.of_int (210)) (Prims.of_int (13)) + (Prims.of_int (210)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (209)) (Prims.of_int (4)) - (Prims.of_int (211)) (Prims.of_int (12))))) + (Prims.of_int (211)) (Prims.of_int (4)) + (Prims.of_int (213)) (Prims.of_int (12))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (208)) + (Prims.of_int (210)) (Prims.of_int (25)) - (Prims.of_int (208)) + (Prims.of_int (210)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (208)) + (Prims.of_int (210)) (Prims.of_int (13)) - (Prims.of_int (208)) + (Prims.of_int (210)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_env ())) (fun uu___2 -> @@ -1303,13 +1214,13 @@ let (global : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (214)) (Prims.of_int (4)) - (Prims.of_int (214)) (Prims.of_int (60))))) + (Prims.of_int (216)) (Prims.of_int (4)) + (Prims.of_int (216)) (Prims.of_int (60))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (215)) (Prims.of_int (4)) - (Prims.of_int (218)) (Prims.of_int (16))))) + (Prims.of_int (217)) (Prims.of_int (4)) + (Prims.of_int (220)) (Prims.of_int (16))))) (Obj.magic (debug (fun uu___1 -> @@ -1318,8 +1229,8 @@ let (global : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (214)) (Prims.of_int (41)) - (Prims.of_int (214)) (Prims.of_int (59))))) + (Prims.of_int (216)) (Prims.of_int (41)) + (Prims.of_int (216)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "prims.fst" @@ -1343,17 +1254,17 @@ let (global : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (216)) + (Prims.of_int (218)) (Prims.of_int (24)) - (Prims.of_int (216)) + (Prims.of_int (218)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (217)) + (Prims.of_int (219)) (Prims.of_int (14)) - (Prims.of_int (217)) + (Prims.of_int (219)) (Prims.of_int (52))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1361,17 +1272,17 @@ let (global : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (216)) + (Prims.of_int (218)) (Prims.of_int (27)) - (Prims.of_int (216)) + (Prims.of_int (218)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (216)) + (Prims.of_int (218)) (Prims.of_int (24)) - (Prims.of_int (216)) + (Prims.of_int (218)) (Prims.of_int (58))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_env ())) @@ -1397,12 +1308,12 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (232)) (Prims.of_int (4)) (Prims.of_int (233)) + (Prims.of_int (228)) (Prims.of_int (4)) (Prims.of_int (229)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (234)) (Prims.of_int (4)) (Prims.of_int (255)) + (Prims.of_int (230)) (Prims.of_int (4)) (Prims.of_int (257)) (Prims.of_int (60))))) (if st.fuel <= Prims.int_zero then FStar_Tactics_Effect.raise NoInst @@ -1414,13 +1325,13 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (234)) (Prims.of_int (4)) - (Prims.of_int (234)) (Prims.of_int (55))))) + (Prims.of_int (230)) (Prims.of_int (4)) + (Prims.of_int (230)) (Prims.of_int (55))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (236)) (Prims.of_int (4)) - (Prims.of_int (255)) (Prims.of_int (60))))) + (Prims.of_int (232)) (Prims.of_int (4)) + (Prims.of_int (257)) (Prims.of_int (60))))) (Obj.magic (debug (fun uu___1 -> @@ -1439,14 +1350,14 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (236)) (Prims.of_int (4)) - (Prims.of_int (236)) (Prims.of_int (18))))) + (Prims.of_int (232)) (Prims.of_int (4)) + (Prims.of_int (232)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (236)) (Prims.of_int (19)) - (Prims.of_int (255)) (Prims.of_int (60))))) + (Prims.of_int (232)) (Prims.of_int (19)) + (Prims.of_int (257)) (Prims.of_int (60))))) (Obj.magic (maybe_intros ())) (fun uu___2 -> (fun uu___2 -> @@ -1456,17 +1367,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (237)) + (Prims.of_int (233)) (Prims.of_int (12)) - (Prims.of_int (237)) + (Prims.of_int (233)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (240)) + (Prims.of_int (236)) (Prims.of_int (4)) - (Prims.of_int (255)) + (Prims.of_int (257)) (Prims.of_int (60))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_goal @@ -1479,17 +1390,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (240)) + (Prims.of_int (236)) (Prims.of_int (4)) - (Prims.of_int (243)) + (Prims.of_int (239)) (Prims.of_int (5))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (245)) + (Prims.of_int (241)) (Prims.of_int (4)) - (Prims.of_int (255)) + (Prims.of_int (257)) (Prims.of_int (60))))) (if FStar_List_Tot_Base.existsb @@ -1503,17 +1414,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (241)) + (Prims.of_int (237)) (Prims.of_int (6)) - (Prims.of_int (241)) + (Prims.of_int (237)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (242)) + (Prims.of_int (238)) (Prims.of_int (6)) - (Prims.of_int (242)) + (Prims.of_int (238)) (Prims.of_int (18))))) (Obj.magic (debug @@ -1544,17 +1455,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (245)) + (Prims.of_int (241)) (Prims.of_int (10)) - (Prims.of_int (245)) + (Prims.of_int (241)) (Prims.of_int (15))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (245)) + (Prims.of_int (241)) (Prims.of_int (4)) - (Prims.of_int (255)) + (Prims.of_int (257)) (Prims.of_int (60))))) (Obj.magic (hua g)) @@ -1572,17 +1483,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (247)) + (Prims.of_int (243)) (Prims.of_int (6)) - (Prims.of_int (247)) + (Prims.of_int (243)) (Prims.of_int (61))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (248)) + (Prims.of_int (244)) (Prims.of_int (6)) - (Prims.of_int (248)) + (Prims.of_int (244)) (Prims.of_int (18))))) (Obj.magic (debug @@ -1611,17 +1522,110 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (248)) + (Prims.of_int (17)) + (Prims.of_int (248)) + (Prims.of_int (61))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (248)) + (Prims.of_int (64)) + (Prims.of_int (257)) + (Prims.of_int (60))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (248)) + (Prims.of_int (28)) + (Prims.of_int (248)) + (Prims.of_int (40))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (248)) + (Prims.of_int (17)) + (Prims.of_int (248)) + (Prims.of_int (61))))) + (Obj.magic + (FStar_Tactics_V2_Derived.cur_env + ())) + (fun + uu___5 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___6 -> + FStar_Reflection_V2_Builtins.lookup_typ + uu___5 + (FStar_Reflection_V2_Builtins.inspect_fv + head_fv))))) + (fun + uu___5 -> + (fun c_se + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (249)) + (Prims.of_int (20)) (Prims.of_int (251)) + (Prims.of_int (39))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (252)) + (Prims.of_int (8)) + (Prims.of_int (257)) + (Prims.of_int (60))))) + (match c_se + with + | + FStar_Pervasives_Native.None + -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___5 -> + FStar_Pervasives_Native.None))) + | + FStar_Pervasives_Native.Some + se -> + Obj.magic + (Obj.repr + (extract_fundeps + se))) + (fun + uu___5 -> + (fun + fundeps + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (254)) (Prims.of_int (27)) - (Prims.of_int (251)) + (Prims.of_int (254)) (Prims.of_int (89))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (251)) + (Prims.of_int (254)) (Prims.of_int (92)) - (Prims.of_int (255)) + (Prims.of_int (257)) (Prims.of_int (60))))) (Obj.magic (FStar_Tactics_Util.map @@ -1636,17 +1640,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (251)) + (Prims.of_int (254)) (Prims.of_int (67)) - (Prims.of_int (251)) + (Prims.of_int (254)) (Prims.of_int (88))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (251)) + (Prims.of_int (254)) (Prims.of_int (59)) - (Prims.of_int (251)) + (Prims.of_int (254)) (Prims.of_int (88))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1654,17 +1658,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (251)) + (Prims.of_int (254)) (Prims.of_int (73)) - (Prims.of_int (251)) + (Prims.of_int (254)) (Prims.of_int (88))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (251)) + (Prims.of_int (254)) (Prims.of_int (67)) - (Prims.of_int (251)) + (Prims.of_int (254)) (Prims.of_int (88))))) (Obj.magic (FStar_Tactics_V2_Builtins.free_uvars @@ -1695,17 +1699,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (253)) + (Prims.of_int (255)) (Prims.of_int (17)) - (Prims.of_int (253)) + (Prims.of_int (255)) (Prims.of_int (44))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (253)) - (Prims.of_int (49)) (Prims.of_int (255)) + (Prims.of_int (49)) + (Prims.of_int (257)) (Prims.of_int (60))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -1729,17 +1733,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (254)) + (Prims.of_int (256)) (Prims.of_int (16)) - (Prims.of_int (254)) - (Prims.of_int (73))))) + (Prims.of_int (256)) + (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (255)) + (Prims.of_int (257)) (Prims.of_int (6)) - (Prims.of_int (255)) + (Prims.of_int (257)) (Prims.of_int (60))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -1747,6 +1751,8 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = { g; head_fv; + c_se; + fundeps; args_and_uvars })) (fun @@ -1764,6 +1770,8 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = uu___5))) uu___5))) uu___5))) + uu___5))) + uu___5))) uu___4))) uu___3))) uu___3))) uu___2))) uu___1))) uu___) @@ -1789,14 +1797,14 @@ let rec concatMap : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (260)) (Prims.of_int (13)) - (Prims.of_int (260)) (Prims.of_int (16))))) + (Prims.of_int (262)) (Prims.of_int (13)) + (Prims.of_int (262)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (260)) (Prims.of_int (13)) - (Prims.of_int (260)) (Prims.of_int (33))))) + (Prims.of_int (262)) (Prims.of_int (13)) + (Prims.of_int (262)) (Prims.of_int (33))))) (Obj.magic (f x)) (fun uu___ -> (fun uu___ -> @@ -1806,17 +1814,17 @@ let rec concatMap : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (260)) + (Prims.of_int (262)) (Prims.of_int (19)) - (Prims.of_int (260)) + (Prims.of_int (262)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (260)) + (Prims.of_int (262)) (Prims.of_int (13)) - (Prims.of_int (260)) + (Prims.of_int (262)) (Prims.of_int (33))))) (Obj.magic (concatMap f xs)) (fun uu___1 -> @@ -1829,12 +1837,12 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (264)) (Prims.of_int (4)) (Prims.of_int (264)) + (Prims.of_int (267)) (Prims.of_int (4)) (Prims.of_int (267)) (Prims.of_int (54))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (264)) (Prims.of_int (55)) (Prims.of_int (295)) + (Prims.of_int (267)) (Prims.of_int (55)) (Prims.of_int (300)) (Prims.of_int (18))))) (Obj.magic (debug @@ -1843,13 +1851,13 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (264)) (Prims.of_int (21)) - (Prims.of_int (264)) (Prims.of_int (28))))) + (Prims.of_int (267)) (Prims.of_int (21)) + (Prims.of_int (267)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (264)) (Prims.of_int (30)) - (Prims.of_int (264)) (Prims.of_int (53))))) + (Prims.of_int (267)) (Prims.of_int (30)) + (Prims.of_int (267)) (Prims.of_int (53))))) (Obj.magic (FStar_Tactics_V2_Builtins.dump "")) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -1861,13 +1869,13 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (265)) (Prims.of_int (12)) - (Prims.of_int (265)) (Prims.of_int (26))))) + (Prims.of_int (268)) (Prims.of_int (12)) + (Prims.of_int (268)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (268)) (Prims.of_int (4)) - (Prims.of_int (295)) (Prims.of_int (18))))) + (Prims.of_int (269)) (Prims.of_int (4)) + (Prims.of_int (300)) (Prims.of_int (18))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_witness ())) (fun uu___2 -> (fun w -> @@ -1877,15 +1885,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (268)) (Prims.of_int (4)) - (Prims.of_int (268)) (Prims.of_int (19))))) + (Prims.of_int (269)) (Prims.of_int (4)) + (Prims.of_int (269)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (268)) (Prims.of_int (20)) - (Prims.of_int (295)) (Prims.of_int (18))))) - (Obj.magic (maybe_intros ())) + (Prims.of_int (272)) (Prims.of_int (4)) + (Prims.of_int (300)) (Prims.of_int (18))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.set_dump_on_failure + false)) (fun uu___2 -> (fun uu___2 -> Obj.magic @@ -1894,122 +1904,147 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (273)) - (Prims.of_int (14)) - (Prims.of_int (273)) - (Prims.of_int (56))))) + (Prims.of_int (272)) + (Prims.of_int (4)) + (Prims.of_int (272)) + (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (273)) - (Prims.of_int (59)) - (Prims.of_int (295)) + (Prims.of_int (272)) + (Prims.of_int (20)) + (Prims.of_int (300)) (Prims.of_int (18))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (273)) - (Prims.of_int (44)) - (Prims.of_int (273)) - (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (273)) - (Prims.of_int (14)) - (Prims.of_int (273)) - (Prims.of_int (56))))) - (Obj.magic - (FStar_Tactics_V2_Derived.cur_env - ())) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStar_Reflection_V2_Builtins.lookup_attr_ses - (FStar_Reflection_V2_Builtins.pack_ln - (FStar_Reflection_V2_Data.Tv_FVar - (FStar_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Typeclasses"; - "tcinstance"]))) - uu___3)))) + (Obj.magic (maybe_intros ())) (fun uu___3 -> - (fun glb -> + (fun uu___3 -> Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (274)) + (Prims.of_int (277)) (Prims.of_int (14)) - (Prims.of_int (276)) - (Prims.of_int (5))))) + (Prims.of_int (277)) + (Prims.of_int (56))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" (Prims.of_int (277)) - (Prims.of_int (6)) - (Prims.of_int (295)) + (Prims.of_int (59)) + (Prims.of_int (300)) (Prims.of_int (18))))) (Obj.magic - (concatMap - (fun se -> - concatMap - (fun uu___3 -> - (fun fv -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___3 -> - [ - (se, fv)]))) - uu___3) - (sigelt_name se)) - glb)) - (fun uu___3 -> - (fun glb1 -> + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (277)) + (Prims.of_int (44)) + (Prims.of_int (277)) + (Prims.of_int (56))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (277)) + (Prims.of_int (14)) + (Prims.of_int (277)) + (Prims.of_int (56))))) + (Obj.magic + (FStar_Tactics_V2_Derived.cur_env + ())) + (fun uu___4 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___5 -> + FStar_Reflection_V2_Builtins.lookup_attr_ses + (FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; + "Tactics"; + "Typeclasses"; + "tcinstance"]))) + uu___4)))) + (fun uu___4 -> + (fun glb -> Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (279)) - (Prims.of_int (6)) - (Prims.of_int (281)) - (Prims.of_int (16))))) + (Prims.of_int (278)) + (Prims.of_int (14)) + (Prims.of_int (280)) + (Prims.of_int (5))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (281)) + (Prims.of_int (6)) + (Prims.of_int (300)) + (Prims.of_int (18))))) + (Obj.magic + (concatMap + (fun se -> + concatMap + (fun + uu___4 -> + (fun fv + -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___4 -> + [ + (se, fv)]))) + uu___4) + (sigelt_name + se)) glb)) + (fun uu___4 -> + (fun glb1 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" (Prims.of_int (283)) + (Prims.of_int (6)) + (Prims.of_int (285)) + (Prims.of_int (16))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (287)) (Prims.of_int (4)) - (Prims.of_int (295)) + (Prims.of_int (300)) (Prims.of_int (18))))) - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 - -> - { + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___4 -> + { seen = []; glb = glb1; fuel = (Prims.of_int (16)) - })) - (fun uu___3 -> - (fun st0 -> - Obj.magic + })) + (fun + uu___4 -> + (fun st0 + -> + Obj.magic (FStar_Tactics_V2_Derived.try_with (fun - uu___3 -> + uu___4 -> match () with | @@ -2019,37 +2054,37 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (284)) + (Prims.of_int (288)) (Prims.of_int (6)) - (Prims.of_int (284)) + (Prims.of_int (288)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (285)) + (Prims.of_int (289)) (Prims.of_int (6)) - (Prims.of_int (285)) + (Prims.of_int (289)) (Prims.of_int (59))))) (Obj.magic (tcresolve' st0)) (fun - uu___4 -> + uu___5 -> (fun - uu___4 -> + uu___5 -> Obj.magic (debug (fun - uu___5 -> + uu___6 -> FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (285)) + (Prims.of_int (289)) (Prims.of_int (42)) - (Prims.of_int (285)) + (Prims.of_int (289)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic @@ -2063,19 +2098,19 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Tactics_V2_Builtins.term_to_string w)) (fun - uu___6 -> + uu___7 -> FStar_Tactics_Effect.lift_div_tac (fun - uu___7 -> + uu___8 -> Prims.strcat "Solved to:\n\t" - uu___6))))) - uu___4)) + uu___7))))) + uu___5)) (fun - uu___3 -> + uu___4 -> (fun - uu___3 -> - match uu___3 + uu___4 -> + match uu___4 with | NoInst -> @@ -2086,17 +2121,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (289)) + (Prims.of_int (293)) (Prims.of_int (15)) - (Prims.of_int (292)) + (Prims.of_int (297)) (Prims.of_int (7))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (289)) + (Prims.of_int (293)) (Prims.of_int (6)) - (Prims.of_int (292)) + (Prims.of_int (297)) (Prims.of_int (7))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2104,17 +2139,35 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (290)) + (Prims.of_int (293)) + (Prims.of_int (15)) + (Prims.of_int (297)) + (Prims.of_int (7))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (293)) + (Prims.of_int (15)) + (Prims.of_int (297)) + (Prims.of_int (7))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (295)) (Prims.of_int (8)) - (Prims.of_int (291)) + (Prims.of_int (296)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (289)) + (Prims.of_int (293)) (Prims.of_int (15)) - (Prims.of_int (292)) + (Prims.of_int (297)) (Prims.of_int (7))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2122,17 +2175,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (291)) + (Prims.of_int (296)) (Prims.of_int (10)) - (Prims.of_int (291)) + (Prims.of_int (296)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (290)) + (Prims.of_int (295)) (Prims.of_int (8)) - (Prims.of_int (291)) + (Prims.of_int (296)) (Prims.of_int (59))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2140,17 +2193,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (291)) + (Prims.of_int (296)) (Prims.of_int (28)) - (Prims.of_int (291)) + (Prims.of_int (296)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (291)) + (Prims.of_int (296)) (Prims.of_int (10)) - (Prims.of_int (291)) + (Prims.of_int (296)) (Prims.of_int (59))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2158,57 +2211,65 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (291)) + (Prims.of_int (296)) (Prims.of_int (44)) - (Prims.of_int (291)) + (Prims.of_int (296)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (291)) + (Prims.of_int (296)) (Prims.of_int (28)) - (Prims.of_int (291)) + (Prims.of_int (296)) (Prims.of_int (58))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_goal ())) (fun - uu___4 -> + uu___5 -> (fun - uu___4 -> + uu___5 -> Obj.magic (FStar_Tactics_V2_Builtins.term_to_string - uu___4)) - uu___4))) + uu___5)) + uu___5))) (fun - uu___4 -> + uu___5 -> FStar_Tactics_Effect.lift_div_tac (fun - uu___5 -> + uu___6 -> FStar_Pprint.arbitrary_string - uu___4)))) + uu___5)))) (fun - uu___4 -> + uu___5 -> FStar_Tactics_Effect.lift_div_tac (fun - uu___5 -> + uu___6 -> FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one (FStar_Pprint.arbitrary_string "Could not solve constraint") - uu___4)))) + uu___5)))) (fun - uu___4 -> + uu___5 -> FStar_Tactics_Effect.lift_div_tac (fun + uu___6 -> + [uu___5])))) + (fun uu___5 -> - [uu___4])))) + FStar_Tactics_Effect.lift_div_tac (fun - uu___4 -> + uu___6 -> + (FStar_Pprint.arbitrary_string + "Typeclass resolution failed") + :: uu___5)))) + (fun + uu___5 -> FStar_Tactics_V2_Derived.fail_doc - uu___4))) + uu___5))) | FStar_Tactics_Common.TacticFailure msg -> @@ -2227,9 +2288,10 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.repr (FStar_Tactics_Effect.raise e))) - uu___3))) - uu___3))) - uu___3))) uu___3))) + uu___4))) + uu___4))) + uu___4))) + uu___4))) uu___3))) uu___2))) uu___2))) uu___1) let _ = FStar_Tactics_Native.register_tactic "FStar.Tactics.Typeclasses.tcresolve" @@ -2265,8 +2327,8 @@ let rec (mk_abs : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (304)) (Prims.of_int (20)) - (Prims.of_int (304)) (Prims.of_int (47))))) + (Prims.of_int (309)) (Prims.of_int (20)) + (Prims.of_int (309)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "dummy" Prims.int_zero @@ -2277,17 +2339,17 @@ let rec (mk_abs : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (304)) + (Prims.of_int (309)) (Prims.of_int (30)) - (Prims.of_int (304)) + (Prims.of_int (309)) (Prims.of_int (46))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (304)) + (Prims.of_int (309)) (Prims.of_int (20)) - (Prims.of_int (304)) + (Prims.of_int (309)) (Prims.of_int (47))))) (Obj.magic (mk_abs bs1 body)) (fun uu___ -> @@ -2346,12 +2408,12 @@ let (mk_class : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (328)) (Prims.of_int (13)) (Prims.of_int (328)) + (Prims.of_int (333)) (Prims.of_int (13)) (Prims.of_int (333)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (328)) (Prims.of_int (29)) (Prims.of_int (418)) + (Prims.of_int (333)) (Prims.of_int (29)) (Prims.of_int (423)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Reflection_V2_Builtins.explode_qn nm)) @@ -2362,27 +2424,27 @@ let (mk_class : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (329)) (Prims.of_int (12)) - (Prims.of_int (329)) (Prims.of_int (38))))) + (Prims.of_int (334)) (Prims.of_int (12)) + (Prims.of_int (334)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (330)) (Prims.of_int (4)) - (Prims.of_int (418)) (Prims.of_int (5))))) + (Prims.of_int (335)) (Prims.of_int (4)) + (Prims.of_int (423)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (329)) (Prims.of_int (23)) - (Prims.of_int (329)) (Prims.of_int (35))))) + (Prims.of_int (334)) (Prims.of_int (23)) + (Prims.of_int (334)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (329)) (Prims.of_int (12)) - (Prims.of_int (329)) (Prims.of_int (38))))) + (Prims.of_int (334)) (Prims.of_int (12)) + (Prims.of_int (334)) (Prims.of_int (38))))) (Obj.magic (FStar_Tactics_V2_Builtins.top_env ())) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac @@ -2397,14 +2459,14 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (330)) (Prims.of_int (4)) - (Prims.of_int (330)) (Prims.of_int (19))))) + (Prims.of_int (335)) (Prims.of_int (4)) + (Prims.of_int (335)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (330)) (Prims.of_int (20)) - (Prims.of_int (418)) (Prims.of_int (5))))) + (Prims.of_int (335)) (Prims.of_int (20)) + (Prims.of_int (423)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard (FStar_Pervasives_Native.uu___is_Some r))) @@ -2416,17 +2478,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (331)) + (Prims.of_int (336)) (Prims.of_int (18)) - (Prims.of_int (331)) + (Prims.of_int (336)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (330)) + (Prims.of_int (335)) (Prims.of_int (20)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> r)) @@ -2441,17 +2503,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (332)) + (Prims.of_int (337)) (Prims.of_int (23)) - (Prims.of_int (332)) + (Prims.of_int (337)) (Prims.of_int (115))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (332)) + (Prims.of_int (337)) (Prims.of_int (118)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> @@ -2476,18 +2538,18 @@ let (mk_class : Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (333)) + (Prims.of_int (338)) (Prims.of_int (13)) - (Prims.of_int (333)) + (Prims.of_int (338)) (Prims.of_int (30))))) (FStar_Sealed.seal ( Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (334)) + (Prims.of_int (339)) (Prims.of_int (4)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (Obj.magic ( @@ -2503,17 +2565,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (334)) + (Prims.of_int (339)) (Prims.of_int (4)) - (Prims.of_int (334)) + (Prims.of_int (339)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (334)) + (Prims.of_int (339)) (Prims.of_int (29)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard @@ -2529,17 +2591,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (335)) + (Prims.of_int (340)) (Prims.of_int (63)) - (Prims.of_int (335)) + (Prims.of_int (340)) (Prims.of_int (65))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (334)) + (Prims.of_int (339)) (Prims.of_int (29)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2571,17 +2633,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (336)) + (Prims.of_int (341)) (Prims.of_int (4)) - (Prims.of_int (336)) + (Prims.of_int (341)) (Prims.of_int (87))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (337)) + (Prims.of_int (342)) (Prims.of_int (4)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2592,9 +2654,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (336)) + (Prims.of_int (341)) (Prims.of_int (35)) - (Prims.of_int (336)) + (Prims.of_int (341)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -2626,17 +2688,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (337)) + (Prims.of_int (342)) (Prims.of_int (4)) - (Prims.of_int (337)) + (Prims.of_int (342)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (338)) + (Prims.of_int (343)) (Prims.of_int (4)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2663,17 +2725,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (338)) + (Prims.of_int (343)) (Prims.of_int (4)) - (Prims.of_int (338)) + (Prims.of_int (343)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (338)) + (Prims.of_int (343)) (Prims.of_int (60)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2684,9 +2746,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (338)) + (Prims.of_int (343)) (Prims.of_int (40)) - (Prims.of_int (338)) + (Prims.of_int (343)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic @@ -2717,17 +2779,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (339)) + (Prims.of_int (344)) (Prims.of_int (20)) - (Prims.of_int (339)) + (Prims.of_int (344)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (341)) + (Prims.of_int (346)) (Prims.of_int (4)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (Obj.magic (last @@ -2743,17 +2805,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (341)) + (Prims.of_int (346)) (Prims.of_int (4)) - (Prims.of_int (341)) + (Prims.of_int (346)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (341)) + (Prims.of_int (346)) (Prims.of_int (31)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard @@ -2770,17 +2832,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (342)) + (Prims.of_int (347)) (Prims.of_int (25)) - (Prims.of_int (342)) + (Prims.of_int (347)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (341)) + (Prims.of_int (346)) (Prims.of_int (31)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2802,17 +2864,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (343)) + (Prims.of_int (348)) (Prims.of_int (4)) - (Prims.of_int (343)) + (Prims.of_int (348)) (Prims.of_int (87))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (343)) + (Prims.of_int (348)) (Prims.of_int (88)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2823,9 +2885,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (343)) + (Prims.of_int (348)) (Prims.of_int (35)) - (Prims.of_int (343)) + (Prims.of_int (348)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -2841,9 +2903,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (343)) + (Prims.of_int (348)) (Prims.of_int (55)) - (Prims.of_int (343)) + (Prims.of_int (348)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -2859,9 +2921,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (343)) + (Prims.of_int (348)) (Prims.of_int (69)) - (Prims.of_int (343)) + (Prims.of_int (348)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -2915,17 +2977,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (344)) + (Prims.of_int (349)) (Prims.of_int (18)) - (Prims.of_int (344)) + (Prims.of_int (349)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (343)) + (Prims.of_int (348)) (Prims.of_int (88)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_arr_bs @@ -2947,17 +3009,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (345)) + (Prims.of_int (350)) (Prims.of_int (12)) - (Prims.of_int (345)) + (Prims.of_int (350)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (346)) + (Prims.of_int (351)) (Prims.of_int (4)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2976,17 +3038,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (346)) + (Prims.of_int (351)) (Prims.of_int (4)) - (Prims.of_int (346)) + (Prims.of_int (351)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (346)) + (Prims.of_int (351)) (Prims.of_int (23)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard @@ -3004,17 +3066,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (347)) + (Prims.of_int (352)) (Prims.of_int (22)) - (Prims.of_int (347)) + (Prims.of_int (352)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (346)) + (Prims.of_int (351)) (Prims.of_int (23)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3037,17 +3099,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (349)) + (Prims.of_int (354)) (Prims.of_int (4)) - (Prims.of_int (349)) + (Prims.of_int (354)) (Prims.of_int (87))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (350)) + (Prims.of_int (355)) (Prims.of_int (4)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (Obj.magic (debug @@ -3059,9 +3121,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (349)) + (Prims.of_int (354)) (Prims.of_int (35)) - (Prims.of_int (349)) + (Prims.of_int (354)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -3097,17 +3159,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (350)) + (Prims.of_int (355)) (Prims.of_int (4)) - (Prims.of_int (350)) + (Prims.of_int (355)) (Prims.of_int (81))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (351)) + (Prims.of_int (356)) (Prims.of_int (4)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (Obj.magic (debug @@ -3140,17 +3202,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (351)) + (Prims.of_int (356)) (Prims.of_int (4)) - (Prims.of_int (351)) + (Prims.of_int (356)) (Prims.of_int (76))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (352)) + (Prims.of_int (357)) (Prims.of_int (4)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (Obj.magic (debug @@ -3183,17 +3245,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (352)) + (Prims.of_int (357)) (Prims.of_int (4)) - (Prims.of_int (352)) + (Prims.of_int (357)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (352)) + (Prims.of_int (357)) (Prims.of_int (52)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (Obj.magic (debug @@ -3205,9 +3267,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (352)) + (Prims.of_int (357)) (Prims.of_int (32)) - (Prims.of_int (352)) + (Prims.of_int (357)) (Prims.of_int (50))))) (FStar_Sealed.seal (Obj.magic @@ -3242,17 +3304,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (356)) + (Prims.of_int (361)) (Prims.of_int (24)) - (Prims.of_int (356)) + (Prims.of_int (361)) (Prims.of_int (61))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (359)) + (Prims.of_int (364)) (Prims.of_int (4)) - (Prims.of_int (418)) + (Prims.of_int (423)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3276,17 +3338,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (361)) + (Prims.of_int (366)) (Prims.of_int (14)) - (Prims.of_int (361)) + (Prims.of_int (366)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (362)) + (Prims.of_int (367)) (Prims.of_int (6)) - (Prims.of_int (417)) + (Prims.of_int (422)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_V2_Derived.name_of_binder @@ -3301,17 +3363,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (362)) + (Prims.of_int (367)) (Prims.of_int (6)) - (Prims.of_int (362)) + (Prims.of_int (367)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (362)) + (Prims.of_int (367)) (Prims.of_int (49)) - (Prims.of_int (417)) + (Prims.of_int (422)) (Prims.of_int (8))))) (Obj.magic (debug @@ -3342,17 +3404,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (363)) + (Prims.of_int (368)) (Prims.of_int (15)) - (Prims.of_int (363)) + (Prims.of_int (368)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (363)) + (Prims.of_int (368)) (Prims.of_int (31)) - (Prims.of_int (417)) + (Prims.of_int (422)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_module @@ -3368,17 +3430,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (364)) + (Prims.of_int (369)) (Prims.of_int (16)) - (Prims.of_int (364)) + (Prims.of_int (369)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (364)) + (Prims.of_int (369)) (Prims.of_int (37)) - (Prims.of_int (417)) + (Prims.of_int (422)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3399,17 +3461,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (365)) + (Prims.of_int (370)) (Prims.of_int (16)) - (Prims.of_int (365)) + (Prims.of_int (370)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (365)) + (Prims.of_int (370)) (Prims.of_int (41)) - (Prims.of_int (417)) + (Prims.of_int (422)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_V2_Derived.fresh_namedv_named @@ -3425,17 +3487,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (366)) + (Prims.of_int (371)) (Prims.of_int (16)) - (Prims.of_int (366)) + (Prims.of_int (371)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (366)) + (Prims.of_int (371)) (Prims.of_int (31)) - (Prims.of_int (417)) + (Prims.of_int (422)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3459,17 +3521,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (368)) + (Prims.of_int (373)) (Prims.of_int (8)) - (Prims.of_int (372)) + (Prims.of_int (377)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (373)) + (Prims.of_int (378)) (Prims.of_int (10)) - (Prims.of_int (417)) + (Prims.of_int (422)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3477,17 +3539,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (370)) + (Prims.of_int (375)) (Prims.of_int (17)) - (Prims.of_int (370)) + (Prims.of_int (375)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (368)) + (Prims.of_int (373)) (Prims.of_int (8)) - (Prims.of_int (372)) + (Prims.of_int (377)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V2_Builtins.fresh @@ -3526,17 +3588,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (374)) + (Prims.of_int (379)) (Prims.of_int (22)) - (Prims.of_int (374)) + (Prims.of_int (379)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (374)) + (Prims.of_int (379)) (Prims.of_int (51)) - (Prims.of_int (417)) + (Prims.of_int (422)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3544,17 +3606,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (374)) + (Prims.of_int (379)) (Prims.of_int (22)) - (Prims.of_int (374)) + (Prims.of_int (379)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (374)) + (Prims.of_int (379)) (Prims.of_int (22)) - (Prims.of_int (374)) + (Prims.of_int (379)) (Prims.of_int (48))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_module @@ -3583,17 +3645,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (375)) + (Prims.of_int (380)) (Prims.of_int (17)) - (Prims.of_int (375)) + (Prims.of_int (380)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (375)) + (Prims.of_int (380)) (Prims.of_int (54)) - (Prims.of_int (417)) + (Prims.of_int (422)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3614,17 +3676,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (378)) - (Prims.of_int (8)) (Prims.of_int (383)) + (Prims.of_int (8)) + (Prims.of_int (388)) (Prims.of_int (50))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (384)) + (Prims.of_int (389)) (Prims.of_int (8)) - (Prims.of_int (417)) + (Prims.of_int (422)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3632,17 +3694,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (378)) + (Prims.of_int (383)) (Prims.of_int (14)) - (Prims.of_int (378)) + (Prims.of_int (383)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (378)) - (Prims.of_int (8)) (Prims.of_int (383)) + (Prims.of_int (8)) + (Prims.of_int (388)) (Prims.of_int (50))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3650,17 +3712,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (378)) + (Prims.of_int (383)) (Prims.of_int (25)) - (Prims.of_int (378)) + (Prims.of_int (383)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (378)) + (Prims.of_int (383)) (Prims.of_int (14)) - (Prims.of_int (378)) + (Prims.of_int (383)) (Prims.of_int (47))))) (Obj.magic (FStar_Tactics_V2_Builtins.top_env @@ -3700,17 +3762,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (381)) + (Prims.of_int (386)) (Prims.of_int (16)) - (Prims.of_int (381)) + (Prims.of_int (386)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (381)) + (Prims.of_int (386)) (Prims.of_int (10)) - (Prims.of_int (383)) + (Prims.of_int (388)) (Prims.of_int (50))))) (Obj.magic (FStar_Tactics_NamedView.inspect_sigelt @@ -3757,17 +3819,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (387)) + (Prims.of_int (392)) (Prims.of_int (14)) - (Prims.of_int (394)) + (Prims.of_int (399)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (395)) + (Prims.of_int (400)) (Prims.of_int (8)) - (Prims.of_int (417)) + (Prims.of_int (422)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3775,17 +3837,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (388)) + (Prims.of_int (393)) (Prims.of_int (22)) - (Prims.of_int (388)) + (Prims.of_int (393)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (387)) + (Prims.of_int (392)) (Prims.of_int (14)) - (Prims.of_int (394)) + (Prims.of_int (399)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_arr_bs @@ -3807,17 +3869,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (389)) + (Prims.of_int (394)) (Prims.of_int (21)) - (Prims.of_int (389)) + (Prims.of_int (394)) (Prims.of_int (75))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (388)) + (Prims.of_int (393)) (Prims.of_int (54)) - (Prims.of_int (394)) + (Prims.of_int (399)) (Prims.of_int (37))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3856,17 +3918,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (393)) + (Prims.of_int (398)) (Prims.of_int (21)) - (Prims.of_int (393)) + (Prims.of_int (398)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (394)) + (Prims.of_int (399)) (Prims.of_int (12)) - (Prims.of_int (394)) + (Prims.of_int (399)) (Prims.of_int (37))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3900,17 +3962,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (396)) + (Prims.of_int (401)) (Prims.of_int (15)) - (Prims.of_int (403)) + (Prims.of_int (408)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (405)) + (Prims.of_int (410)) (Prims.of_int (6)) - (Prims.of_int (417)) + (Prims.of_int (422)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3918,17 +3980,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (397)) + (Prims.of_int (402)) (Prims.of_int (23)) - (Prims.of_int (397)) + (Prims.of_int (402)) (Prims.of_int (49))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (396)) + (Prims.of_int (401)) (Prims.of_int (15)) - (Prims.of_int (403)) + (Prims.of_int (408)) (Prims.of_int (38))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_abs @@ -3950,17 +4012,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (398)) + (Prims.of_int (403)) (Prims.of_int (21)) - (Prims.of_int (398)) + (Prims.of_int (403)) (Prims.of_int (75))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (397)) + (Prims.of_int (402)) (Prims.of_int (52)) - (Prims.of_int (403)) + (Prims.of_int (408)) (Prims.of_int (38))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3999,17 +4061,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (402)) + (Prims.of_int (407)) (Prims.of_int (21)) - (Prims.of_int (402)) + (Prims.of_int (407)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (403)) + (Prims.of_int (408)) (Prims.of_int (12)) - (Prims.of_int (403)) + (Prims.of_int (408)) (Prims.of_int (38))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -4043,17 +4105,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (405)) + (Prims.of_int (410)) (Prims.of_int (6)) - (Prims.of_int (405)) + (Prims.of_int (410)) (Prims.of_int (53))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (406)) + (Prims.of_int (411)) (Prims.of_int (6)) - (Prims.of_int (417)) + (Prims.of_int (422)) (Prims.of_int (8))))) (Obj.magic (debug @@ -4065,9 +4127,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (405)) + (Prims.of_int (410)) (Prims.of_int (34)) - (Prims.of_int (405)) + (Prims.of_int (410)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic @@ -4102,17 +4164,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (406)) + (Prims.of_int (411)) (Prims.of_int (6)) - (Prims.of_int (406)) + (Prims.of_int (411)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (406)) + (Prims.of_int (411)) (Prims.of_int (53)) - (Prims.of_int (417)) + (Prims.of_int (422)) (Prims.of_int (8))))) (Obj.magic (debug @@ -4124,9 +4186,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (406)) + (Prims.of_int (411)) (Prims.of_int (34)) - (Prims.of_int (406)) + (Prims.of_int (411)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic @@ -4161,17 +4223,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (408)) + (Prims.of_int (413)) (Prims.of_int (22)) - (Prims.of_int (408)) + (Prims.of_int (413)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (408)) + (Prims.of_int (413)) (Prims.of_int (27)) - (Prims.of_int (417)) + (Prims.of_int (422)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -4188,17 +4250,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (409)) + (Prims.of_int (414)) (Prims.of_int (23)) - (Prims.of_int (409)) + (Prims.of_int (414)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (409)) + (Prims.of_int (414)) (Prims.of_int (29)) - (Prims.of_int (417)) + (Prims.of_int (422)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -4215,17 +4277,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (410)) + (Prims.of_int (415)) (Prims.of_int (21)) - (Prims.of_int (410)) + (Prims.of_int (415)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (410)) + (Prims.of_int (415)) (Prims.of_int (27)) - (Prims.of_int (417)) + (Prims.of_int (422)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -4242,17 +4304,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (412)) + (Prims.of_int (417)) (Prims.of_int (17)) - (Prims.of_int (412)) + (Prims.of_int (417)) (Prims.of_int (70))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (412)) - (Prims.of_int (75)) (Prims.of_int (417)) + (Prims.of_int (75)) + (Prims.of_int (422)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -4280,17 +4342,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (413)) + (Prims.of_int (418)) (Prims.of_int (15)) - (Prims.of_int (413)) + (Prims.of_int (418)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (415)) + (Prims.of_int (420)) (Prims.of_int (15)) - (Prims.of_int (415)) + (Prims.of_int (420)) (Prims.of_int (42))))) (Obj.magic (FStar_Tactics_NamedView.pack_sigelt From b94c8ac5a5bbad6f7384c2cabe1783aac87bb095 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 29 Apr 2024 14:47:50 -0700 Subject: [PATCH 149/239] Update expected output --- tests/error-messages/Bug1918.fst.expected | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/tests/error-messages/Bug1918.fst.expected b/tests/error-messages/Bug1918.fst.expected index 75046b09eda..59d8d956fab 100644 --- a/tests/error-messages/Bug1918.fst.expected +++ b/tests/error-messages/Bug1918.fst.expected @@ -1,13 +1,9 @@ -proof-state: State dump @ depth 0 (at the time of failure): -Location: FStar.Tactics.Typeclasses.fst(289,6-292,7) -Goal 1/1: - |- _ : Bug1918.mon - >> Got issues: [ * Error 228 at Bug1918.fst(11,13-11,14): - Tactic failed + - Typeclass resolution failed - Could not solve constraint Bug1918.mon - - See also FStar.Tactics.Typeclasses.fst(289,6-292,7) + - See also FStar.Tactics.Typeclasses.fst(293,6-297,7) >>] Verified module: Bug1918 From 762f59a0231cb2a7a62fe6c7bf710b9de60b205c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 29 Apr 2024 14:49:58 -0700 Subject: [PATCH 150/239] Makefile: parallelize output rule --- Makefile | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index fbd4f9206f8..d8510ef23f2 100644 --- a/Makefile +++ b/Makefile @@ -127,10 +127,22 @@ bench: # Regenerate and accept expected output tests. Should be manually # reviewed before checking in. .PHONY: output -output: +output: output-error-messages output-ide-emacs output-ide-lsp output-bug-reports + +.PHONY: output-error-messages +output-error-messages: +$(Q)$(MAKE) -C tests/error-messages accept + +.PHONY: output-ide-emacs +output-ide-emacs: +$(Q)$(MAKE) -C tests/ide/emacs accept + +.PHONY: output-ide-lsp +output-ide-lsp: +$(Q)$(MAKE) -C tests/ide/lsp accept + +.PHONY: output-bug-reports +output-bug-reports: +$(Q)$(MAKE) -C tests/bug-reports output-accept # This rule is meant to mimic what the docker based CI does, but it From b85bee9c3184653eef8397a465cba21d686e182b Mon Sep 17 00:00:00 2001 From: Nikhil Swamy Date: Tue, 30 Apr 2024 09:47:23 -0700 Subject: [PATCH 151/239] eq_tm and eq_t disregard non-injective type parameters in equality tests of data constructors --- .../generated/FStar_TypeChecker_NBETerm.ml | 19 +------------------ .../FStar_TypeChecker_TermEqAndSimplify.ml | 7 +------ src/typechecker/FStar.TypeChecker.NBETerm.fst | 6 +----- .../FStar.TypeChecker.TermEqAndSimplify.fst | 9 +-------- tests/bug-reports/BugBoxInjectivity.fst | 9 +++------ 5 files changed, 7 insertions(+), 43 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml index 14b4af2363b..2894ce29619 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml @@ -520,24 +520,7 @@ let rec (eq_t : | (parms1, args11) -> let uu___4 = FStar_Compiler_List.splitAt n args2 in (match uu___4 with - | (parms2, args21) -> - let uu___5 = - let uu___6 = eq_args1 args11 args21 in - uu___6 = - FStar_TypeChecker_TermEqAndSimplify.Equal in - if uu___5 - then - let uu___6 = - let uu___7 = eq_args1 parms1 parms2 in - uu___7 = - FStar_TypeChecker_TermEqAndSimplify.Equal in - (if uu___6 - then - FStar_TypeChecker_TermEqAndSimplify.Equal - else - FStar_TypeChecker_TermEqAndSimplify.Unknown) - else - FStar_TypeChecker_TermEqAndSimplify.NotEqual)) + | (parms2, args21) -> eq_args1 args11 args21)) else FStar_TypeChecker_TermEqAndSimplify.Unknown)) else FStar_TypeChecker_TermEqAndSimplify.NotEqual | (FV (v1, us1, args1), FV (v2, us2, args2)) -> diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml index e606fdf9d14..3adb921da18 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml @@ -81,12 +81,7 @@ let rec (eq_tm : | ((a1, q1), (a2, q2)) -> let uu___5 = eq_tm env a1 a2 in eq_inj acc uu___5) Equal as1 as2 in - let args_eq = eq_arg_list args11 args21 in - if args_eq = Equal - then - let parms_eq = eq_arg_list parms1 parms2 in - (if parms_eq = Equal then Equal else Unknown) - else args_eq) + eq_arg_list args11 args21) else Unknown) else NotEqual in let qual_is_inj uu___ = diff --git a/src/typechecker/FStar.TypeChecker.NBETerm.fst b/src/typechecker/FStar.TypeChecker.NBETerm.fst index 8a0d40ea096..827b5adc481 100644 --- a/src/typechecker/FStar.TypeChecker.NBETerm.fst +++ b/src/typechecker/FStar.TypeChecker.NBETerm.fst @@ -136,11 +136,7 @@ let rec eq_t env (t1 : t) (t2 : t) : TEQ.eq_result = in let parms1, args1 = List.splitAt n args1 in let parms2, args2 = List.splitAt n args2 in - if eq_args args1 args2 = TEQ.Equal - then if eq_args parms1 parms2 = TEQ.Equal - then TEQ.Equal - else TEQ.Unknown - else TEQ.NotEqual + eq_args args1 args2 ) else TEQ.Unknown end else TEQ.NotEqual diff --git a/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst b/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst index 386d664457f..87624e5b7aa 100644 --- a/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst +++ b/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst @@ -104,14 +104,7 @@ let rec eq_tm (env:env_t) (t1:term) (t2:term) : eq_result = as1 as2 in - let args_eq = eq_arg_list args1 args2 in - if args_eq = Equal - then - let parms_eq = eq_arg_list parms1 parms2 in - if parms_eq = Equal - then Equal - else Unknown - else args_eq + eq_arg_list args1 args2 ) else Unknown ) diff --git a/tests/bug-reports/BugBoxInjectivity.fst b/tests/bug-reports/BugBoxInjectivity.fst index 538de27e266..0651f1ea109 100644 --- a/tests/bug-reports/BugBoxInjectivity.fst +++ b/tests/bug-reports/BugBoxInjectivity.fst @@ -112,22 +112,19 @@ let case2 (x0 : test3 A1) (x1 : test3 A2) : Lemma False = T.trefl ()) -[@@expect_failure] let case4 (x0 : test3 A1) (x1 : test3 A2) : Lemma (test3 A1 == test3 A2 ==> Mk3 #A1 == coerce_eq () (Mk3 #A2)) = assume (test3 A1 == test3 A2); assert (Mk3 #A1 == coerce_eq () (Mk3 #A2)) by (T.norm [delta;primops]; - T.trivial()) //this can't be proven by the normalizer alone + T.trivial()) //this can be proven by the normalizer alone -[@@expect_failure] let case5 (x0 : test3 A1) (x1 : test3 A2) : Lemma (test3 A1 == test3 A2 ==> Mk3 #A1 == coerce_eq () (Mk3 #A2)) = assume (test3 A1 == test3 A2); assert (Mk3 #A1 == coerce_eq () (Mk3 #A2)) by (T.norm [delta;primops;nbe]; - T.trivial()) //this can't be proven by the normalizer alone; nor by nbe + T.trivial()) //this can be proven by the normalizer alone; nor by nbe let case6 (x0 : test3 A1) (x1 : test3 A2) : Lemma (test3 A1 == test3 A2 ==> Mk3 #A1 == coerce_eq () (Mk3 #A2)) = assume (test3 A1 == test3 A2); assert (Mk3 #A1 == coerce_eq () (Mk3 #A2)) - by (T.norm [delta;primops]; - T.smt()) //but it can by SMT, since the parameters are irrelevant + by (T.smt()) //but it can also by SMT, since the parameters are irrelevant From 20dbde8656a620ef838b1f52099183f1121f53a8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Tue, 30 Apr 2024 18:32:03 -0700 Subject: [PATCH 152/239] Resugar: fix potential infinite loop This makes it so that we call universe_to_int with a compressed universe. Fixes #3280 --- src/syntax/FStar.Syntax.Resugar.fst | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/syntax/FStar.Syntax.Resugar.fst b/src/syntax/FStar.Syntax.Resugar.fst index 72112cda06c..fa00ec02b61 100644 --- a/src/syntax/FStar.Syntax.Resugar.fst +++ b/src/syntax/FStar.Syntax.Resugar.fst @@ -84,7 +84,7 @@ let label s t = else A.mk_term (A.Labeled (t,s,true)) t.range A.Un let rec universe_to_int n u = - match u with + match Subst.compress_univ u with | U_succ u -> universe_to_int (n+1) u | _ -> (n, u) @@ -98,7 +98,8 @@ let rec resugar_universe (u:S.universe) r: A.term = //augment `a` an Unknown level (the level is unimportant ... we should maybe remove it altogether) A.mk_term a r A.Un in - begin match Subst.compress_univ u with + let u = Subst.compress_univ u in + begin match u with | U_zero -> mk (A.Const(Const_int ("0", None))) r From 50d93f4477827ac5221c8cbcd073a0c40dd095a1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Tue, 30 Apr 2024 00:05:57 -0700 Subject: [PATCH 153/239] Tactics.TypeRepr: add a tactic to translate inductives to a sums of products representation --- ulib/FStar.Tactics.TypeRepr.fst | 170 +++++++++++++++++++++++++++++++ ulib/FStar.Tactics.TypeRepr.fsti | 21 ++++ 2 files changed, 191 insertions(+) create mode 100644 ulib/FStar.Tactics.TypeRepr.fst create mode 100644 ulib/FStar.Tactics.TypeRepr.fsti diff --git a/ulib/FStar.Tactics.TypeRepr.fst b/ulib/FStar.Tactics.TypeRepr.fst new file mode 100644 index 00000000000..16b6a6395d7 --- /dev/null +++ b/ulib/FStar.Tactics.TypeRepr.fst @@ -0,0 +1,170 @@ +module FStar.Tactics.TypeRepr + +//#set-options "--print_implicits --print_full_names --print_universes" + +open FStar.Tactics.V2 + +let add_suffix (s:string) (nm:name) : name = + explode_qn (implode_qn nm ^ s) + +let unitv_ : term = `() +let unitt_ : term = `(unit) +let empty_ : term = `(empty) +let either_ (a b : term) : term = `(either (`#a) (`#b)) +let tuple2_ (a b : term) : term = `(tuple2 (`#a) (`#b)) +let mktuple2_ (a b : term) : term = `(Mktuple2 (`#a) (`#b)) + +let get_inductive_typ (nm:string) : Tac (se:sigelt_view{Sg_Inductive? se}) = + let e = top_env () in + let se = lookup_typ e (explode_qn nm) in + match se with + | None -> fail "ctors_of_typ: type not found" + | Some se -> + let sev = inspect_sigelt se in + if Sg_Inductive? sev then + sev + else + fail "ctors_of_typ: not an inductive type" + +let alg_ctor (ty : typ) : Tac typ = + let tys, c = collect_arr ty in + Tactics.Util.fold_right (fun ty acc -> tuple2_ ty acc) tys unitt_ + +[@@plugin] +let generate_repr_typ (params : binders) (ctors : list ctor) : Tac typ = + let ctor_typs = Util.map (fun (_, ty) -> alg_ctor ty) ctors in + let alternative_typ = + Util.fold_right (fun ty acc -> either_ ty acc) ctor_typs empty_ in + alternative_typ + +(* Expects a goal of type [t -> t_repr] *) +[@@plugin] +let generate_down () : Tac unit = + let b = intro () in + let cases = t_destruct b in + cases |> Util.iteri #(fv & nat) (fun i (c, n) -> + let bs = repeatn n (fun _ -> intro ()) in + let _b_eq = intro () in + let sol = Util.fold_right (fun (b:binding) acc -> mktuple2_ b acc) bs unitv_ in + let _ = repeatn i (fun _ -> apply (`Inr)) in + apply (`Inl); + exact sol + ) + +let rec get_apply_tuple (b:binding) : Tac (list binding) = + let hd, args = collect_app b.sort in + match inspect hd, args with + | Tv_UInst fv _, [b1; b2] + | Tv_FVar fv, [b1; b2] -> + if inspect_fv fv = explode_qn (`%tuple2) then + let cases = t_destruct b in + guard (List.Tot.length cases = 1 && inspect_fv (fst (List.Tot.hd cases)) = explode_qn (`%Mktuple2) && snd (List.Tot.hd cases) = 2); + let b1 = intro () in + let b2 = intro () in + let _eq = intro () in + b1 :: get_apply_tuple b2 + else + fail ("unexpected term in apply_tuple: " ^ term_to_string b.sort) + | Tv_FVar fv, [] -> + if inspect_fv fv = explode_qn (`%unit) then + [] + else + fail ("unexpected term in apply_tuple: " ^ term_to_string b.sort) + | _ -> + fail ("unexpected term in apply_tuple: " ^ term_to_string b.sort) + +(* Expects a goal of type [t_repr -> t] *) + +let rec generate_up_aux (ctors : list ctor) (b:binding) : Tac unit = + match ctors with + | [] -> + (* b must have type empty, it's the finisher for the cases *) + apply (`empty_elim); + exact b + | c::cs -> + let cases = t_destruct b in + if List.Tot.length cases <> 2 then + fail "generate_up_aux: expected Inl/Inr???"; + focus (fun () -> + let b' = intro () in + let _eq = intro () in + let c_name = fst c in + let args = get_apply_tuple b' in + apply (pack (Tv_FVar (pack_fv c_name))); + Util.iter (fun (b:binding) -> exact b) args; + qed() + ); + let b = intro () in + let _eq = intro () in + generate_up_aux cs b + +(* Expects a goal of type [t_repr -> t] *) +[@@plugin] +let generate_up (nm:string) () : Tac unit = + let Sg_Inductive {ctors} = get_inductive_typ nm in + let b = intro () in + generate_up_aux ctors b + +let make_implicits (bs : binders) : binders = + bs |> List.Tot.map (fun b -> + match b.qual with + | Q_Explicit -> { b with qual = Q_Implicit } + | _ -> b + ) + +let binder_to_argv (b:binder) : argv = + (binder_to_term b, b.qual) + +let generate_all (nm:name) (params:binders) (ctors : list ctor) : Tac decls = + let params_i = make_implicits params in + let t = mk_app (pack (Tv_FVar (pack_fv nm))) (List.Tot.map binder_to_argv params) in + let t_repr = generate_repr_typ params ctors in + let se_repr = pack_sigelt <| Sg_Let { + isrec = false; + lbs = [{ + lb_fv = pack_fv (add_suffix "_repr" nm); + lb_us = []; + lb_typ = mk_arr params <| C_Total (`Type); + lb_def = mk_abs params t_repr; + }] + } + in + + let down_def = + `(_ by (generate_down ())) + in + let down_def = mk_abs params_i down_def in + let se_down = + let b = fresh_binder t in + pack_sigelt <| Sg_Let { + isrec = false; + lbs = [{ + lb_fv = pack_fv (add_suffix "_down" nm); + lb_us = []; + lb_typ = mk_tot_arr params_i <| Tv_Arrow b (C_Total t_repr); + lb_def = down_def; + }] + } + in + let up_def = + `(_ by (generate_up (`#(pack (Tv_Const (C_String (implode_qn nm))))) ())) + in + let up_def = mk_abs params_i up_def in + let se_up = + let b = fresh_binder t_repr in + pack_sigelt <| Sg_Let { + isrec = false; + lbs = [{ + lb_fv = pack_fv (add_suffix "_up" nm); + lb_us = []; + lb_typ = mk_tot_arr params_i <| Tv_Arrow b (C_Total t); + lb_def = up_def; + }] + } + in + [se_repr; se_down; se_up] + +[@@plugin] +let entry (nm : string) : Tac decls = + let Sg_Inductive {params; nm; ctors} = get_inductive_typ nm in + generate_all nm params ctors diff --git a/ulib/FStar.Tactics.TypeRepr.fsti b/ulib/FStar.Tactics.TypeRepr.fsti new file mode 100644 index 00000000000..8b03aa51cb3 --- /dev/null +++ b/ulib/FStar.Tactics.TypeRepr.fsti @@ -0,0 +1,21 @@ +module FStar.Tactics.TypeRepr + +open FStar.Tactics.V2 + +private +let empty_elim (e:empty) (#a:Type) : a = match e with + +(* Do not use directly. *) +[@@plugin] +val generate_repr_typ (params : binders) (ctors : list ctor) : Tac typ + +(* Do not use directly. *) +[@@plugin] +val generate_down () : Tac unit + +(* Do not use directly. *) +[@@plugin] +val generate_up (nm:string) () : Tac unit + +[@@plugin] +val entry (nm : string) : Tac decls From b583e1e6eb515ee92984c1a95d5a0a5917c3d24a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Tue, 30 Apr 2024 00:06:47 -0700 Subject: [PATCH 154/239] snap --- .../generated/FStar_Syntax_Resugar.ml | 103 +- .../generated/FStar_Tactics_TypeRepr.ml | 2369 +++++++++++++++++ 2 files changed, 2421 insertions(+), 51 deletions(-) create mode 100644 ocaml/fstar-lib/generated/FStar_Tactics_TypeRepr.ml diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml index ada658eb397..3aea0687b97 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml @@ -90,10 +90,11 @@ let rec (universe_to_int : = fun n -> fun u -> - match u with + let uu___ = FStar_Syntax_Subst.compress_univ u in + match uu___ with | FStar_Syntax_Syntax.U_succ u1 -> universe_to_int (n + Prims.int_one) u1 - | uu___ -> (n, u) + | uu___1 -> (n, u) let (universe_to_string : FStar_Ident.ident Prims.list -> Prims.string) = fun univs -> let uu___ = FStar_Options.print_universes () in @@ -110,73 +111,73 @@ let rec (resugar_universe : fun u -> fun r -> let mk a r1 = FStar_Parser_AST.mk_term a r1 FStar_Parser_AST.Un in - let uu___ = FStar_Syntax_Subst.compress_univ u in - match uu___ with + let u1 = FStar_Syntax_Subst.compress_univ u in + match u1 with | FStar_Syntax_Syntax.U_zero -> mk (FStar_Parser_AST.Const (FStar_Const.Const_int ("0", FStar_Pervasives_Native.None))) r - | FStar_Syntax_Syntax.U_succ uu___1 -> - let uu___2 = universe_to_int Prims.int_zero u in - (match uu___2 with - | (n, u1) -> - (match u1 with + | FStar_Syntax_Syntax.U_succ uu___ -> + let uu___1 = universe_to_int Prims.int_zero u1 in + (match uu___1 with + | (n, u2) -> + (match u2 with | FStar_Syntax_Syntax.U_zero -> - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = FStar_Compiler_Util.string_of_int n in - (uu___6, FStar_Pervasives_Native.None) in - FStar_Const.Const_int uu___5 in - FStar_Parser_AST.Const uu___4 in - mk uu___3 r - | uu___3 -> + let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = FStar_Compiler_Util.string_of_int n in + (uu___5, FStar_Pervasives_Native.None) in + FStar_Const.Const_int uu___4 in + FStar_Parser_AST.Const uu___3 in + mk uu___2 r + | uu___2 -> let e1 = + let uu___3 = + let uu___4 = + let uu___5 = + let uu___6 = FStar_Compiler_Util.string_of_int n in + (uu___6, FStar_Pervasives_Native.None) in + FStar_Const.Const_int uu___5 in + FStar_Parser_AST.Const uu___4 in + mk uu___3 r in + let e2 = resugar_universe u2 r in + let uu___3 = let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = FStar_Compiler_Util.string_of_int n in - (uu___7, FStar_Pervasives_Native.None) in - FStar_Const.Const_int uu___6 in - FStar_Parser_AST.Const uu___5 in - mk uu___4 r in - let e2 = resugar_universe u1 r in - let uu___4 = - let uu___5 = - let uu___6 = FStar_Ident.id_of_text "+" in - (uu___6, [e1; e2]) in - FStar_Parser_AST.Op uu___5 in - mk uu___4 r)) + let uu___5 = FStar_Ident.id_of_text "+" in + (uu___5, [e1; e2]) in + FStar_Parser_AST.Op uu___4 in + mk uu___3 r)) | FStar_Syntax_Syntax.U_max l -> (match l with | [] -> FStar_Compiler_Effect.failwith "Impossible: U_max without arguments" - | uu___1 -> + | uu___ -> let t = - let uu___2 = - let uu___3 = FStar_Ident.lid_of_path ["max"] r in - FStar_Parser_AST.Var uu___3 in - mk uu___2 r in + let uu___1 = + let uu___2 = FStar_Ident.lid_of_path ["max"] r in + FStar_Parser_AST.Var uu___2 in + mk uu___1 r in FStar_Compiler_List.fold_left (fun acc -> fun x -> - let uu___2 = - let uu___3 = - let uu___4 = resugar_universe x r in - (acc, uu___4, FStar_Parser_AST.Nothing) in - FStar_Parser_AST.App uu___3 in - mk uu___2 r) t l) - | FStar_Syntax_Syntax.U_name u1 -> mk (FStar_Parser_AST.Uvar u1) r - | FStar_Syntax_Syntax.U_unif uu___1 -> mk FStar_Parser_AST.Wild r + let uu___1 = + let uu___2 = + let uu___3 = resugar_universe x r in + (acc, uu___3, FStar_Parser_AST.Nothing) in + FStar_Parser_AST.App uu___2 in + mk uu___1 r) t l) + | FStar_Syntax_Syntax.U_name u2 -> mk (FStar_Parser_AST.Uvar u2) r + | FStar_Syntax_Syntax.U_unif uu___ -> mk FStar_Parser_AST.Wild r | FStar_Syntax_Syntax.U_bvar x -> let id = - let uu___1 = - let uu___2 = - let uu___3 = FStar_Compiler_Util.string_of_int x in - FStar_Compiler_Util.strcat "uu__univ_bvar_" uu___3 in - (uu___2, r) in - FStar_Ident.mk_ident uu___1 in + let uu___ = + let uu___1 = + let uu___2 = FStar_Compiler_Util.string_of_int x in + FStar_Compiler_Util.strcat "uu__univ_bvar_" uu___2 in + (uu___1, r) in + FStar_Ident.mk_ident uu___ in mk (FStar_Parser_AST.Uvar id) r | FStar_Syntax_Syntax.U_unknown -> mk FStar_Parser_AST.Wild r let (resugar_universe' : diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_TypeRepr.ml b/ocaml/fstar-lib/generated/FStar_Tactics_TypeRepr.ml new file mode 100644 index 00000000000..c8214fd829e --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_Tactics_TypeRepr.ml @@ -0,0 +1,2369 @@ +open Prims +let (empty_elim : Prims.empty -> unit -> Obj.t) = + fun uu___1 -> + fun uu___ -> + (fun e -> fun a -> Obj.magic (failwith "unreachable")) uu___1 uu___ +let (add_suffix : + Prims.string -> FStar_Reflection_Types.name -> FStar_Reflection_Types.name) + = + fun s -> + fun nm -> + FStar_Reflection_V2_Builtins.explode_qn + (Prims.strcat (FStar_Reflection_V2_Builtins.implode_qn nm) s) +let (unitv_ : FStar_Tactics_NamedView.term) = + FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_Const FStar_Reflection_V2_Data.C_Unit) +let (unitt_ : FStar_Tactics_NamedView.term) = + FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv ["Prims"; "unit"])) +let (empty_ : FStar_Tactics_NamedView.term) = + FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv ["Prims"; "empty"])) +let (either_ : + FStar_Tactics_NamedView.term -> + FStar_Tactics_NamedView.term -> FStar_Tactics_NamedView.term) + = + fun a -> + fun b -> + FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; "Pervasives"; "either"]))), + (a, FStar_Reflection_V2_Data.Q_Explicit)))), + (b, FStar_Reflection_V2_Data.Q_Explicit))) +let (tuple2_ : + FStar_Tactics_NamedView.term -> + FStar_Tactics_NamedView.term -> FStar_Tactics_NamedView.term) + = + fun a -> + fun b -> + FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; "Pervasives"; "Native"; "tuple2"]))), + (a, FStar_Reflection_V2_Data.Q_Explicit)))), + (b, FStar_Reflection_V2_Data.Q_Explicit))) +let (mktuple2_ : + FStar_Tactics_NamedView.term -> + FStar_Tactics_NamedView.term -> FStar_Tactics_NamedView.term) + = + fun a -> + fun b -> + FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; "Pervasives"; "Native"; "Mktuple2"]))), + (a, FStar_Reflection_V2_Data.Q_Explicit)))), + (b, FStar_Reflection_V2_Data.Q_Explicit))) +let (get_inductive_typ : + Prims.string -> + (FStar_Tactics_NamedView.sigelt_view, unit) FStar_Tactics_Effect.tac_repr) + = + fun nm -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (18)) (Prims.of_int (10)) (Prims.of_int (18)) + (Prims.of_int (20))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (18)) (Prims.of_int (23)) (Prims.of_int (27)) + (Prims.of_int (48))))) + (Obj.magic (FStar_Tactics_V2_Builtins.top_env ())) + (fun uu___ -> + (fun e -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (19)) (Prims.of_int (11)) + (Prims.of_int (19)) (Prims.of_int (39))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (20)) (Prims.of_int (2)) + (Prims.of_int (27)) (Prims.of_int (48))))) + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> + FStar_Reflection_V2_Builtins.lookup_typ e + (FStar_Reflection_V2_Builtins.explode_qn nm))) + (fun uu___ -> + (fun se -> + match se with + | FStar_Pervasives_Native.None -> + Obj.magic + (Obj.repr + (FStar_Tactics_V2_Derived.fail + "ctors_of_typ: type not found")) + | FStar_Pervasives_Native.Some se1 -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (23)) + (Prims.of_int (14)) + (Prims.of_int (23)) + (Prims.of_int (31))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (24)) + (Prims.of_int (4)) + (Prims.of_int (27)) + (Prims.of_int (48))))) + (Obj.magic + (FStar_Tactics_NamedView.inspect_sigelt + se1)) + (fun sev -> + if + FStar_Tactics_NamedView.uu___is_Sg_Inductive + sev + then + FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> sev) + else + FStar_Tactics_V2_Derived.fail + "ctors_of_typ: not an inductive type")))) + uu___))) uu___) +let (alg_ctor : + FStar_Reflection_Types.typ -> + (FStar_Reflection_Types.typ, unit) FStar_Tactics_Effect.tac_repr) + = + fun ty -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (30)) (Prims.of_int (15)) (Prims.of_int (30)) + (Prims.of_int (29))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (29)) (Prims.of_int (35)) (Prims.of_int (31)) + (Prims.of_int (67))))) + (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_arr ty)) + (fun uu___ -> + (fun uu___ -> + match uu___ with + | (tys, c) -> + Obj.magic + (FStar_Tactics_Util.fold_right + (fun uu___2 -> + fun uu___1 -> + (fun ty1 -> + fun acc -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___1 -> tuple2_ ty1 acc))) uu___2 + uu___1) tys unitt_)) uu___) +let (generate_repr_typ : + FStar_Tactics_NamedView.binders -> + FStar_Reflection_V2_Data.ctor Prims.list -> + (FStar_Reflection_Types.typ, unit) FStar_Tactics_Effect.tac_repr) + = + fun params -> + fun ctors -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (35)) (Prims.of_int (18)) (Prims.of_int (35)) + (Prims.of_int (61))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (35)) (Prims.of_int (64)) (Prims.of_int (38)) + (Prims.of_int (17))))) + (Obj.magic + (FStar_Tactics_Util.map + (fun uu___ -> match uu___ with | (uu___1, ty) -> alg_ctor ty) + ctors)) + (fun uu___ -> + (fun ctor_typs -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (37)) (Prims.of_int (4)) + (Prims.of_int (37)) (Prims.of_int (67))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (36)) (Prims.of_int (6)) + (Prims.of_int (36)) (Prims.of_int (21))))) + (Obj.magic + (FStar_Tactics_Util.fold_right + (fun uu___1 -> + fun uu___ -> + (fun ty -> + fun acc -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> either_ ty acc))) + uu___1 uu___) ctor_typs empty_)) + (fun alternative_typ -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> alternative_typ)))) uu___) +let _ = + FStar_Tactics_Native.register_tactic + "FStar.Tactics.TypeRepr.generate_repr_typ" (Prims.of_int (3)) + (fun psc -> + fun ncb -> + fun us -> + fun args -> + FStar_Tactics_InterpFuns.mk_tactic_interpretation_2 + "FStar.Tactics.TypeRepr.generate_repr_typ (plugin)" + (FStar_Tactics_Native.from_tactic_2 generate_repr_typ) + (FStar_Syntax_Embeddings.e_list + FStar_Tactics_NamedView.e_binder) + (FStar_Syntax_Embeddings.e_list + (FStar_Syntax_Embeddings.e_tuple2 + (FStar_Syntax_Embeddings.e_list + FStar_Syntax_Embeddings.e_string) + FStar_Reflection_V2_Embeddings.e_term)) + FStar_Reflection_V2_Embeddings.e_term psc ncb us args) +let (generate_down : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = + fun uu___ -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (43)) (Prims.of_int (10)) (Prims.of_int (43)) + (Prims.of_int (18))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (43)) (Prims.of_int (21)) (Prims.of_int (52)) + (Prims.of_int (3))))) + (Obj.magic (FStar_Tactics_V2_Builtins.intro ())) + (fun uu___1 -> + (fun b -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (44)) (Prims.of_int (14)) + (Prims.of_int (44)) (Prims.of_int (26))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (45)) (Prims.of_int (2)) + (Prims.of_int (52)) (Prims.of_int (3))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.t_destruct + (FStar_Tactics_V2_SyntaxCoercions.binding_to_term b))) + (fun uu___1 -> + (fun cases -> + Obj.magic + (FStar_Tactics_Util.iteri + (fun i -> + fun uu___1 -> + match uu___1 with + | (c, n) -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (46)) + (Prims.of_int (13)) + (Prims.of_int (46)) + (Prims.of_int (42))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (46)) + (Prims.of_int (45)) + (Prims.of_int (51)) + (Prims.of_int (13))))) + (Obj.magic + (FStar_Tactics_Util.repeatn n + (fun uu___2 -> + FStar_Tactics_V2_Builtins.intro + ()))) + (fun uu___2 -> + (fun bs -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (47)) + (Prims.of_int (16)) + (Prims.of_int (47)) + (Prims.of_int (24))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (47)) + (Prims.of_int (27)) + (Prims.of_int (51)) + (Prims.of_int (13))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun uu___2 -> + (fun _b_eq -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (48)) + (Prims.of_int (14)) + (Prims.of_int (48)) + (Prims.of_int (80))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (48)) + (Prims.of_int (83)) + (Prims.of_int (51)) + (Prims.of_int (13))))) + (Obj.magic + (FStar_Tactics_Util.fold_right + (fun + uu___3 -> + fun + uu___2 -> + (fun b1 + -> + fun acc + -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___2 -> + mktuple2_ + (FStar_Tactics_V2_SyntaxCoercions.binding_to_term + b1) acc))) + uu___3 + uu___2) + bs unitv_)) + (fun uu___2 -> + (fun sol -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (49)) + (Prims.of_int (12)) + (Prims.of_int (49)) + (Prims.of_int (45))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (50)) + (Prims.of_int (4)) + (Prims.of_int (51)) + (Prims.of_int (13))))) + (Obj.magic + (FStar_Tactics_Util.repeatn + i + (fun + uu___2 -> + FStar_Tactics_V2_Derived.apply + (FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; + "Pervasives"; + "Inr"])))))) + (fun + uu___2 -> + (fun + uu___2 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (50)) + (Prims.of_int (4)) + (Prims.of_int (50)) + (Prims.of_int (16))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (51)) + (Prims.of_int (4)) + (Prims.of_int (51)) + (Prims.of_int (13))))) + (Obj.magic + (FStar_Tactics_V2_Derived.apply + (FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; + "Pervasives"; + "Inl"]))))) + (fun + uu___3 -> + (fun + uu___3 -> + Obj.magic + (FStar_Tactics_V2_Derived.exact + sol)) + uu___3))) + uu___2))) + uu___2))) + uu___2))) uu___2)) + cases)) uu___1))) uu___1) +let _ = + FStar_Tactics_Native.register_tactic "FStar.Tactics.TypeRepr.generate_down" + (Prims.of_int (2)) + (fun psc -> + fun ncb -> + fun us -> + fun args -> + FStar_Tactics_InterpFuns.mk_tactic_interpretation_1 + "FStar.Tactics.TypeRepr.generate_down (plugin)" + (FStar_Tactics_Native.from_tactic_1 generate_down) + FStar_Syntax_Embeddings.e_unit FStar_Syntax_Embeddings.e_unit + psc ncb us args) +let rec (get_apply_tuple : + FStar_Tactics_NamedView.binding -> + (FStar_Tactics_NamedView.binding Prims.list, unit) + FStar_Tactics_Effect.tac_repr) + = + fun b -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (55)) (Prims.of_int (17)) (Prims.of_int (55)) + (Prims.of_int (35))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (54)) (Prims.of_int (58)) (Prims.of_int (74)) + (Prims.of_int (69))))) + (Obj.magic + (FStar_Tactics_V2_SyntaxHelpers.collect_app + b.FStar_Reflection_V2_Data.sort3)) + (fun uu___ -> + (fun uu___ -> + match uu___ with + | (hd, args) -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (56)) (Prims.of_int (8)) + (Prims.of_int (56)) (Prims.of_int (24))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (56)) (Prims.of_int (2)) + (Prims.of_int (74)) (Prims.of_int (69))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (56)) (Prims.of_int (8)) + (Prims.of_int (56)) (Prims.of_int (18))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (56)) (Prims.of_int (8)) + (Prims.of_int (56)) (Prims.of_int (24))))) + (Obj.magic (FStar_Tactics_NamedView.inspect hd)) + (fun uu___1 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> (uu___1, args))))) + (fun uu___1 -> + (fun uu___1 -> + match uu___1 with + | (FStar_Tactics_NamedView.Tv_UInst (fv, uu___2), + b1::b2::[]) -> + Obj.magic + (Obj.repr + (if + (FStar_Reflection_V2_Builtins.inspect_fv + fv) + = + ["FStar"; + "Pervasives"; + "Native"; + "tuple2"] + then + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (60)) + (Prims.of_int (18)) + (Prims.of_int (60)) + (Prims.of_int (30))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (61)) + (Prims.of_int (6)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.t_destruct + (FStar_Tactics_V2_SyntaxCoercions.binding_to_term + b))) + (fun uu___3 -> + (fun cases -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (61)) + (Prims.of_int (6)) + (Prims.of_int (61)) + (Prims.of_int (136))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (61)) + (Prims.of_int (137)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Derived.guard + ((((FStar_List_Tot_Base.length + cases) + = + Prims.int_one) + && + ((FStar_Reflection_V2_Builtins.inspect_fv + (FStar_Pervasives_Native.fst + (FStar_List_Tot_Base.hd + cases))) + = + ["FStar"; + "Pervasives"; + "Native"; + "Mktuple2"])) + && + ((FStar_Pervasives_Native.snd + (FStar_List_Tot_Base.hd + cases)) + = + (Prims.of_int (2)))))) + (fun uu___3 -> + (fun uu___3 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (62)) + (Prims.of_int (15)) + (Prims.of_int (62)) + (Prims.of_int (23))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (62)) + (Prims.of_int (26)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun uu___4 -> + (fun b11 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (63)) + (Prims.of_int (15)) + (Prims.of_int (63)) + (Prims.of_int (23))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (63)) + (Prims.of_int (26)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun + uu___4 -> + (fun b21 + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (64)) + (Prims.of_int (16)) + (Prims.of_int (64)) + (Prims.of_int (24))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (65)) + (Prims.of_int (6)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun + uu___4 -> + (fun _eq + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (65)) + (Prims.of_int (12)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (65)) + (Prims.of_int (6)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (get_apply_tuple + b21)) + (fun + uu___4 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___5 -> + b11 :: + uu___4)))) + uu___4))) + uu___4))) + uu___4))) + uu___3))) uu___3) + else + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (67)) + (Prims.of_int (11)) + (Prims.of_int (67)) + (Prims.of_int (71))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (67)) + (Prims.of_int (6)) + (Prims.of_int (67)) + (Prims.of_int (71))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (67)) + (Prims.of_int (49)) + (Prims.of_int (67)) + (Prims.of_int (70))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "prims.fst" + (Prims.of_int (590)) + (Prims.of_int (19)) + (Prims.of_int (590)) + (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string + b.FStar_Reflection_V2_Data.sort3)) + (fun uu___4 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___5 -> + Prims.strcat + "unexpected term in apply_tuple: " + uu___4)))) + (fun uu___4 -> + FStar_Tactics_V2_Derived.fail + uu___4))) + | (FStar_Tactics_NamedView.Tv_FVar fv, b1::b2::[]) + -> + Obj.magic + (Obj.repr + (if + (FStar_Reflection_V2_Builtins.inspect_fv + fv) + = + ["FStar"; + "Pervasives"; + "Native"; + "tuple2"] + then + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (60)) + (Prims.of_int (18)) + (Prims.of_int (60)) + (Prims.of_int (30))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (61)) + (Prims.of_int (6)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.t_destruct + (FStar_Tactics_V2_SyntaxCoercions.binding_to_term + b))) + (fun uu___2 -> + (fun cases -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (61)) + (Prims.of_int (6)) + (Prims.of_int (61)) + (Prims.of_int (136))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (61)) + (Prims.of_int (137)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Derived.guard + ((((FStar_List_Tot_Base.length + cases) + = + Prims.int_one) + && + ((FStar_Reflection_V2_Builtins.inspect_fv + (FStar_Pervasives_Native.fst + (FStar_List_Tot_Base.hd + cases))) + = + ["FStar"; + "Pervasives"; + "Native"; + "Mktuple2"])) + && + ((FStar_Pervasives_Native.snd + (FStar_List_Tot_Base.hd + cases)) + = + (Prims.of_int (2)))))) + (fun uu___2 -> + (fun uu___2 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (62)) + (Prims.of_int (15)) + (Prims.of_int (62)) + (Prims.of_int (23))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (62)) + (Prims.of_int (26)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun uu___3 -> + (fun b11 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (63)) + (Prims.of_int (15)) + (Prims.of_int (63)) + (Prims.of_int (23))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (63)) + (Prims.of_int (26)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun + uu___3 -> + (fun b21 + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (64)) + (Prims.of_int (16)) + (Prims.of_int (64)) + (Prims.of_int (24))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (65)) + (Prims.of_int (6)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun + uu___3 -> + (fun _eq + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (65)) + (Prims.of_int (12)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (65)) + (Prims.of_int (6)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (get_apply_tuple + b21)) + (fun + uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___4 -> + b11 :: + uu___3)))) + uu___3))) + uu___3))) + uu___3))) + uu___2))) uu___2) + else + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (67)) + (Prims.of_int (11)) + (Prims.of_int (67)) + (Prims.of_int (71))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (67)) + (Prims.of_int (6)) + (Prims.of_int (67)) + (Prims.of_int (71))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (67)) + (Prims.of_int (49)) + (Prims.of_int (67)) + (Prims.of_int (70))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "prims.fst" + (Prims.of_int (590)) + (Prims.of_int (19)) + (Prims.of_int (590)) + (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string + b.FStar_Reflection_V2_Data.sort3)) + (fun uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> + Prims.strcat + "unexpected term in apply_tuple: " + uu___3)))) + (fun uu___3 -> + FStar_Tactics_V2_Derived.fail + uu___3))) + | (FStar_Tactics_NamedView.Tv_FVar fv, []) -> + Obj.magic + (Obj.repr + (if + (FStar_Reflection_V2_Builtins.inspect_fv + fv) + = ["Prims"; "unit"] + then + Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> [])) + else + Obj.repr + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (72)) + (Prims.of_int (11)) + (Prims.of_int (72)) + (Prims.of_int (71))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (72)) + (Prims.of_int (6)) + (Prims.of_int (72)) + (Prims.of_int (71))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (72)) + (Prims.of_int (49)) + (Prims.of_int (72)) + (Prims.of_int (70))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "prims.fst" + (Prims.of_int (590)) + (Prims.of_int (19)) + (Prims.of_int (590)) + (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string + b.FStar_Reflection_V2_Data.sort3)) + (fun uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> + Prims.strcat + "unexpected term in apply_tuple: " + uu___3)))) + (fun uu___3 -> + FStar_Tactics_V2_Derived.fail + uu___3)))) + | uu___2 -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (74)) + (Prims.of_int (9)) + (Prims.of_int (74)) + (Prims.of_int (69))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (74)) + (Prims.of_int (4)) + (Prims.of_int (74)) + (Prims.of_int (69))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (74)) + (Prims.of_int (47)) + (Prims.of_int (74)) + (Prims.of_int (68))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "prims.fst" + (Prims.of_int (590)) + (Prims.of_int (19)) + (Prims.of_int (590)) + (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string + b.FStar_Reflection_V2_Data.sort3)) + (fun uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> + Prims.strcat + "unexpected term in apply_tuple: " + uu___3)))) + (fun uu___3 -> + FStar_Tactics_V2_Derived.fail + uu___3)))) uu___1))) uu___) +let rec (generate_up_aux : + FStar_Reflection_V2_Data.ctor Prims.list -> + FStar_Tactics_NamedView.binding -> + (unit, unit) FStar_Tactics_Effect.tac_repr) + = + fun ctors -> + fun b -> + match ctors with + | [] -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (82)) (Prims.of_int (4)) + (Prims.of_int (82)) (Prims.of_int (23))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (83)) (Prims.of_int (4)) + (Prims.of_int (83)) (Prims.of_int (11))))) + (Obj.magic + (FStar_Tactics_V2_Derived.apply + (FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; "Tactics"; "TypeRepr"; "empty_elim"]))))) + (fun uu___ -> + (fun uu___ -> + Obj.magic + (FStar_Tactics_V2_Derived.exact + (FStar_Tactics_V2_SyntaxCoercions.binding_to_term b))) + uu___) + | c::cs -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (85)) (Prims.of_int (16)) + (Prims.of_int (85)) (Prims.of_int (28))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (86)) (Prims.of_int (4)) + (Prims.of_int (99)) (Prims.of_int (24))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.t_destruct + (FStar_Tactics_V2_SyntaxCoercions.binding_to_term b))) + (fun uu___ -> + (fun cases -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (86)) (Prims.of_int (4)) + (Prims.of_int (87)) (Prims.of_int (49))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (88)) (Prims.of_int (4)) + (Prims.of_int (99)) (Prims.of_int (24))))) + (if + (FStar_List_Tot_Base.length cases) <> + (Prims.of_int (2)) + then + FStar_Tactics_V2_Derived.fail + "generate_up_aux: expected Inl/Inr???" + else + FStar_Tactics_Effect.lift_div_tac + (fun uu___1 -> ())) + (fun uu___ -> + (fun uu___ -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (88)) + (Prims.of_int (4)) + (Prims.of_int (96)) + (Prims.of_int (5))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (96)) + (Prims.of_int (6)) + (Prims.of_int (99)) + (Prims.of_int (24))))) + (Obj.magic + (FStar_Tactics_V2_Derived.focus + (fun uu___1 -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (89)) + (Prims.of_int (15)) + (Prims.of_int (89)) + (Prims.of_int (23))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (89)) + (Prims.of_int (26)) + (Prims.of_int (95)) + (Prims.of_int (11))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun uu___2 -> + (fun b' -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (90)) + (Prims.of_int (16)) + (Prims.of_int (90)) + (Prims.of_int (24))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (90)) + (Prims.of_int (27)) + (Prims.of_int (95)) + (Prims.of_int (11))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun uu___2 -> + (fun _eq -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (91)) + (Prims.of_int (19)) + (Prims.of_int (91)) + (Prims.of_int (24))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (91)) + (Prims.of_int (27)) + (Prims.of_int (95)) + (Prims.of_int (11))))) + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___2 -> + FStar_Pervasives_Native.fst + c)) + (fun + uu___2 -> + (fun + c_name -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (92)) + (Prims.of_int (17)) + (Prims.of_int (92)) + (Prims.of_int (35))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (93)) + (Prims.of_int (6)) + (Prims.of_int (95)) + (Prims.of_int (11))))) + (Obj.magic + (get_apply_tuple + b')) + (fun + uu___2 -> + (fun args + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (93)) + (Prims.of_int (6)) + (Prims.of_int (93)) + (Prims.of_int (45))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (94)) + (Prims.of_int (6)) + (Prims.of_int (95)) + (Prims.of_int (11))))) + (Obj.magic + (FStar_Tactics_V2_Derived.apply + (FStar_Tactics_NamedView.pack + (FStar_Tactics_NamedView.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + c_name))))) + (fun + uu___2 -> + (fun + uu___2 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (94)) + (Prims.of_int (6)) + (Prims.of_int (94)) + (Prims.of_int (49))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (95)) + (Prims.of_int (6)) + (Prims.of_int (95)) + (Prims.of_int (11))))) + (Obj.magic + (FStar_Tactics_Util.iter + (fun b1 + -> + FStar_Tactics_V2_Derived.exact + (FStar_Tactics_V2_SyntaxCoercions.binding_to_term + b1)) args)) + (fun + uu___3 -> + (fun + uu___3 -> + Obj.magic + (FStar_Tactics_V2_Derived.qed + ())) + uu___3))) + uu___2))) + uu___2))) + uu___2))) + uu___2))) uu___2)))) + (fun uu___1 -> + (fun uu___1 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (97)) + (Prims.of_int (12)) + (Prims.of_int (97)) + (Prims.of_int (20))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (97)) + (Prims.of_int (23)) + (Prims.of_int (99)) + (Prims.of_int (24))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun uu___2 -> + (fun b1 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (98)) + (Prims.of_int (14)) + (Prims.of_int (98)) + (Prims.of_int (22))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (99)) + (Prims.of_int (4)) + (Prims.of_int (99)) + (Prims.of_int (24))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun uu___2 -> + (fun _eq -> + Obj.magic + (generate_up_aux + cs b1)) + uu___2))) uu___2))) + uu___1))) uu___))) uu___) +let (generate_up : + Prims.string -> unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = + fun nm -> + fun uu___ -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (104)) (Prims.of_int (29)) + (Prims.of_int (104)) (Prims.of_int (49))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (103)) (Prims.of_int (43)) + (Prims.of_int (106)) (Prims.of_int (25))))) + (Obj.magic (get_inductive_typ nm)) + (fun uu___1 -> + (fun uu___1 -> + match uu___1 with + | FStar_Tactics_NamedView.Sg_Inductive + { FStar_Tactics_NamedView.nm = uu___2; + FStar_Tactics_NamedView.univs1 = uu___3; + FStar_Tactics_NamedView.params = uu___4; + FStar_Tactics_NamedView.typ = uu___5; + FStar_Tactics_NamedView.ctors = ctors;_} + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (105)) (Prims.of_int (10)) + (Prims.of_int (105)) (Prims.of_int (18))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (106)) (Prims.of_int (2)) + (Prims.of_int (106)) (Prims.of_int (25))))) + (Obj.magic (FStar_Tactics_V2_Builtins.intro ())) + (fun uu___6 -> + (fun b -> Obj.magic (generate_up_aux ctors b)) + uu___6))) uu___1) +let _ = + FStar_Tactics_Native.register_tactic "FStar.Tactics.TypeRepr.generate_up" + (Prims.of_int (3)) + (fun psc -> + fun ncb -> + fun us -> + fun args -> + FStar_Tactics_InterpFuns.mk_tactic_interpretation_2 + "FStar.Tactics.TypeRepr.generate_up (plugin)" + (FStar_Tactics_Native.from_tactic_2 generate_up) + FStar_Syntax_Embeddings.e_string + FStar_Syntax_Embeddings.e_unit FStar_Syntax_Embeddings.e_unit + psc ncb us args) +let (make_implicits : + FStar_Tactics_NamedView.binders -> FStar_Tactics_NamedView.binders) = + fun bs -> + FStar_List_Tot_Base.map + (fun b -> + match b.FStar_Tactics_NamedView.qual with + | FStar_Reflection_V2_Data.Q_Explicit -> + { + FStar_Tactics_NamedView.uniq = + (b.FStar_Tactics_NamedView.uniq); + FStar_Tactics_NamedView.ppname = + (b.FStar_Tactics_NamedView.ppname); + FStar_Tactics_NamedView.sort = + (b.FStar_Tactics_NamedView.sort); + FStar_Tactics_NamedView.qual = + FStar_Reflection_V2_Data.Q_Implicit; + FStar_Tactics_NamedView.attrs = + (b.FStar_Tactics_NamedView.attrs) + } + | uu___ -> b) bs +let (binder_to_argv : + FStar_Tactics_NamedView.binder -> FStar_Reflection_V2_Data.argv) = + fun b -> + ((FStar_Tactics_V2_SyntaxCoercions.binder_to_term b), + (b.FStar_Tactics_NamedView.qual)) +let (generate_all : + FStar_Reflection_Types.name -> + FStar_Tactics_NamedView.binders -> + FStar_Reflection_V2_Data.ctor Prims.list -> + (FStar_Reflection_Types.decls, unit) FStar_Tactics_Effect.tac_repr) + = + fun nm -> + fun params -> + fun ctors -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (119)) (Prims.of_int (17)) + (Prims.of_int (119)) (Prims.of_int (38))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (119)) (Prims.of_int (41)) + (Prims.of_int (165)) (Prims.of_int (27))))) + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> make_implicits params)) + (fun uu___ -> + (fun params_i -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (120)) (Prims.of_int (15)) + (Prims.of_int (120)) (Prims.of_int (88))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (120)) (Prims.of_int (91)) + (Prims.of_int (165)) (Prims.of_int (27))))) + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> + FStar_Reflection_V2_Derived.mk_app + (FStar_Tactics_NamedView.pack + (FStar_Tactics_NamedView.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv nm))) + (FStar_List_Tot_Base.map binder_to_argv params))) + (fun uu___ -> + (fun t -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (121)) + (Prims.of_int (15)) + (Prims.of_int (121)) + (Prims.of_int (45))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (121)) + (Prims.of_int (48)) + (Prims.of_int (165)) + (Prims.of_int (27))))) + (Obj.magic (generate_repr_typ params ctors)) + (fun uu___ -> + (fun t_repr -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (122)) + (Prims.of_int (16)) + (Prims.of_int (130)) + (Prims.of_int (3))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (131)) + (Prims.of_int (4)) + (Prims.of_int (165)) + (Prims.of_int (27))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (122)) + (Prims.of_int (31)) + (Prims.of_int (130)) + (Prims.of_int (3))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (122)) + (Prims.of_int (16)) + (Prims.of_int (130)) + (Prims.of_int (3))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (123)) + (Prims.of_int (4)) + (Prims.of_int (129)) + (Prims.of_int (6))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (122)) + (Prims.of_int (31)) + (Prims.of_int (130)) + (Prims.of_int (3))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (124)) + (Prims.of_int (10)) + (Prims.of_int (129)) + (Prims.of_int (6))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (123)) + (Prims.of_int (4)) + (Prims.of_int (129)) + (Prims.of_int (6))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (125)) + (Prims.of_int (6)) + (Prims.of_int (128)) + (Prims.of_int (36))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (124)) + (Prims.of_int (10)) + (Prims.of_int (129)) + (Prims.of_int (6))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (127)) + (Prims.of_int (15)) + (Prims.of_int (127)) + (Prims.of_int (47))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (125)) + (Prims.of_int (6)) + (Prims.of_int (128)) + (Prims.of_int (36))))) + (Obj.magic + (FStar_Tactics_V2_SyntaxHelpers.mk_arr + params + (FStar_Reflection_V2_Data.C_Total + (FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_Type + (FStar_Reflection_V2_Builtins.pack_universe + FStar_Reflection_V2_Data.Uv_Unk)))))) + (fun + uu___ -> + (fun + uu___ -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (128)) + (Prims.of_int (15)) + (Prims.of_int (128)) + (Prims.of_int (35))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (125)) + (Prims.of_int (6)) + (Prims.of_int (128)) + (Prims.of_int (36))))) + (Obj.magic + (FStar_Tactics_V2_Derived.mk_abs + params + t_repr)) + (fun + uu___1 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___2 -> + { + FStar_Tactics_NamedView.lb_fv + = + (FStar_Reflection_V2_Builtins.pack_fv + (add_suffix + "_repr" + nm)); + FStar_Tactics_NamedView.lb_us + = []; + FStar_Tactics_NamedView.lb_typ + = uu___; + FStar_Tactics_NamedView.lb_def + = uu___1 + })))) + uu___))) + (fun uu___ + -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___1 -> + [uu___])))) + (fun uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___1 + -> + { + FStar_Tactics_NamedView.isrec + = false; + FStar_Tactics_NamedView.lbs + = uu___ + })))) + (fun uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___1 -> + FStar_Tactics_NamedView.Sg_Let + uu___)))) + (fun uu___ -> + (fun uu___ -> + Obj.magic + (FStar_Tactics_NamedView.pack_sigelt + uu___)) uu___))) + (fun uu___ -> + (fun se_repr -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (134)) + (Prims.of_int (4)) + (Prims.of_int (134)) + (Prims.of_int (30))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (135)) + (Prims.of_int (4)) + (Prims.of_int (165)) + (Prims.of_int (27))))) + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> + FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; + "Tactics"; + "Effect"; + "synth_by_tactic"]))), + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_Abs + ((FStar_Reflection_V2_Builtins.pack_binder + { + FStar_Reflection_V2_Data.sort2 + = + (FStar_Reflection_V2_Builtins.pack_ln + FStar_Reflection_V2_Data.Tv_Unknown); + FStar_Reflection_V2_Data.qual + = + FStar_Reflection_V2_Data.Q_Explicit; + FStar_Reflection_V2_Data.attrs + = []; + FStar_Reflection_V2_Data.ppname2 + = + (FStar_Sealed.seal + "uu___") + }), + (FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; + "Tactics"; + "TypeRepr"; + "generate_down"]))), + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_Const + FStar_Reflection_V2_Data.C_Unit)), + FStar_Reflection_V2_Data.Q_Explicit))))))), + FStar_Reflection_V2_Data.Q_Explicit))))) + (fun uu___ -> + (fun down_def -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + ( + Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (136)) + (Prims.of_int (17)) + (Prims.of_int (136)) + (Prims.of_int (41))))) + (FStar_Sealed.seal + ( + Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (136)) + (Prims.of_int (44)) + (Prims.of_int (165)) + (Prims.of_int (27))))) + (Obj.magic + ( + FStar_Tactics_V2_Derived.mk_abs + params_i + down_def)) + (fun uu___ + -> + (fun + down_def1 + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (137)) + (Prims.of_int (15)) + (Prims.of_int (147)) + (Prims.of_int (3))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (148)) + (Prims.of_int (4)) + (Prims.of_int (165)) + (Prims.of_int (27))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (138)) + (Prims.of_int (12)) + (Prims.of_int (138)) + (Prims.of_int (26))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (139)) + (Prims.of_int (4)) + (Prims.of_int (147)) + (Prims.of_int (3))))) + (Obj.magic + (FStar_Tactics_V2_Derived.fresh_binder + t)) + (fun + uu___ -> + (fun b -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (139)) + (Prims.of_int (19)) + (Prims.of_int (147)) + (Prims.of_int (3))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (139)) + (Prims.of_int (4)) + (Prims.of_int (147)) + (Prims.of_int (3))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (140)) + (Prims.of_int (6)) + (Prims.of_int (146)) + (Prims.of_int (8))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (139)) + (Prims.of_int (19)) + (Prims.of_int (147)) + (Prims.of_int (3))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (141)) + (Prims.of_int (12)) + (Prims.of_int (146)) + (Prims.of_int (8))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (140)) + (Prims.of_int (6)) + (Prims.of_int (146)) + (Prims.of_int (8))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (142)) + (Prims.of_int (8)) + (Prims.of_int (145)) + (Prims.of_int (26))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (141)) + (Prims.of_int (12)) + (Prims.of_int (146)) + (Prims.of_int (8))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (144)) + (Prims.of_int (17)) + (Prims.of_int (144)) + (Prims.of_int (67))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (142)) + (Prims.of_int (8)) + (Prims.of_int (145)) + (Prims.of_int (26))))) + (Obj.magic + (FStar_Tactics_V2_SyntaxHelpers.mk_tot_arr + params_i + (FStar_Tactics_NamedView.pack + (FStar_Tactics_NamedView.Tv_Arrow + (b, + (FStar_Reflection_V2_Data.C_Total + t_repr)))))) + (fun + uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___1 -> + { + FStar_Tactics_NamedView.lb_fv + = + (FStar_Reflection_V2_Builtins.pack_fv + (add_suffix + "_down" + nm)); + FStar_Tactics_NamedView.lb_us + = []; + FStar_Tactics_NamedView.lb_typ + = uu___; + FStar_Tactics_NamedView.lb_def + = + down_def1 + })))) + (fun + uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___1 -> + [uu___])))) + (fun + uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___1 -> + { + FStar_Tactics_NamedView.isrec + = false; + FStar_Tactics_NamedView.lbs + = uu___ + })))) + (fun + uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___1 -> + FStar_Tactics_NamedView.Sg_Let + uu___)))) + (fun + uu___ -> + (fun + uu___ -> + Obj.magic + (FStar_Tactics_NamedView.pack_sigelt + uu___)) + uu___))) + uu___))) + (fun + uu___ -> + (fun + se_down + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (150)) + (Prims.of_int (4)) + (Prims.of_int (150)) + (Prims.of_int (77))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (151)) + (Prims.of_int (4)) + (Prims.of_int (165)) + (Prims.of_int (27))))) + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___ -> + FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; + "Tactics"; + "Effect"; + "synth_by_tactic"]))), + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_Abs + ((FStar_Reflection_V2_Builtins.pack_binder + { + FStar_Reflection_V2_Data.sort2 + = + (FStar_Reflection_V2_Builtins.pack_ln + FStar_Reflection_V2_Data.Tv_Unknown); + FStar_Reflection_V2_Data.qual + = + FStar_Reflection_V2_Data.Q_Explicit; + FStar_Reflection_V2_Data.attrs + = []; + FStar_Reflection_V2_Data.ppname2 + = + (FStar_Sealed.seal + "uu___") + }), + (FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; + "Tactics"; + "TypeRepr"; + "generate_up"]))), + ((FStar_Tactics_NamedView.pack + (FStar_Tactics_NamedView.Tv_Const + (FStar_Reflection_V2_Data.C_String + (FStar_Reflection_V2_Builtins.implode_qn + nm)))), + FStar_Reflection_V2_Data.Q_Explicit)))), + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_Const + FStar_Reflection_V2_Data.C_Unit)), + FStar_Reflection_V2_Data.Q_Explicit))))))), + FStar_Reflection_V2_Data.Q_Explicit))))) + (fun + uu___ -> + (fun + up_def -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (152)) + (Prims.of_int (15)) + (Prims.of_int (152)) + (Prims.of_int (37))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (152)) + (Prims.of_int (40)) + (Prims.of_int (165)) + (Prims.of_int (27))))) + (Obj.magic + (FStar_Tactics_V2_Derived.mk_abs + params_i + up_def)) + (fun + uu___ -> + (fun + up_def1 + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (153)) + (Prims.of_int (13)) + (Prims.of_int (163)) + (Prims.of_int (3))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (165)) + (Prims.of_int (2)) + (Prims.of_int (165)) + (Prims.of_int (27))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (154)) + (Prims.of_int (12)) + (Prims.of_int (154)) + (Prims.of_int (31))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (155)) + (Prims.of_int (4)) + (Prims.of_int (163)) + (Prims.of_int (3))))) + (Obj.magic + (FStar_Tactics_V2_Derived.fresh_binder + t_repr)) + (fun + uu___ -> + (fun b -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (155)) + (Prims.of_int (19)) + (Prims.of_int (163)) + (Prims.of_int (3))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (155)) + (Prims.of_int (4)) + (Prims.of_int (163)) + (Prims.of_int (3))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (156)) + (Prims.of_int (6)) + (Prims.of_int (162)) + (Prims.of_int (8))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (155)) + (Prims.of_int (19)) + (Prims.of_int (163)) + (Prims.of_int (3))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (157)) + (Prims.of_int (12)) + (Prims.of_int (162)) + (Prims.of_int (8))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (156)) + (Prims.of_int (6)) + (Prims.of_int (162)) + (Prims.of_int (8))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (158)) + (Prims.of_int (8)) + (Prims.of_int (161)) + (Prims.of_int (24))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (157)) + (Prims.of_int (12)) + (Prims.of_int (162)) + (Prims.of_int (8))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (160)) + (Prims.of_int (17)) + (Prims.of_int (160)) + (Prims.of_int (62))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (158)) + (Prims.of_int (8)) + (Prims.of_int (161)) + (Prims.of_int (24))))) + (Obj.magic + (FStar_Tactics_V2_SyntaxHelpers.mk_tot_arr + params_i + (FStar_Tactics_NamedView.pack + (FStar_Tactics_NamedView.Tv_Arrow + (b, + (FStar_Reflection_V2_Data.C_Total + t)))))) + (fun + uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___1 -> + { + FStar_Tactics_NamedView.lb_fv + = + (FStar_Reflection_V2_Builtins.pack_fv + (add_suffix + "_up" nm)); + FStar_Tactics_NamedView.lb_us + = []; + FStar_Tactics_NamedView.lb_typ + = uu___; + FStar_Tactics_NamedView.lb_def + = up_def1 + })))) + (fun + uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___1 -> + [uu___])))) + (fun + uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___1 -> + { + FStar_Tactics_NamedView.isrec + = false; + FStar_Tactics_NamedView.lbs + = uu___ + })))) + (fun + uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___1 -> + FStar_Tactics_NamedView.Sg_Let + uu___)))) + (fun + uu___ -> + (fun + uu___ -> + Obj.magic + (FStar_Tactics_NamedView.pack_sigelt + uu___)) + uu___))) + uu___))) + (fun + se_up -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___ -> + [se_repr; + se_down; + se_up])))) + uu___))) + uu___))) + uu___))) + uu___))) + uu___))) uu___))) + uu___))) uu___))) uu___) +let (entry : + Prims.string -> + (FStar_Reflection_Types.decls, unit) FStar_Tactics_Effect.tac_repr) + = + fun nm -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (169)) (Prims.of_int (41)) (Prims.of_int (169)) + (Prims.of_int (61))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (168)) (Prims.of_int (37)) (Prims.of_int (170)) + (Prims.of_int (30))))) (Obj.magic (get_inductive_typ nm)) + (fun uu___ -> + (fun uu___ -> + match uu___ with + | FStar_Tactics_NamedView.Sg_Inductive + { FStar_Tactics_NamedView.nm = nm1; + FStar_Tactics_NamedView.univs1 = uu___1; + FStar_Tactics_NamedView.params = params; + FStar_Tactics_NamedView.typ = uu___2; + FStar_Tactics_NamedView.ctors = ctors;_} + -> Obj.magic (generate_all nm1 params ctors)) uu___) +let _ = + FStar_Tactics_Native.register_tactic "FStar.Tactics.TypeRepr.entry" + (Prims.of_int (2)) + (fun psc -> + fun ncb -> + fun us -> + fun args -> + FStar_Tactics_InterpFuns.mk_tactic_interpretation_1 + "FStar.Tactics.TypeRepr.entry (plugin)" + (FStar_Tactics_Native.from_tactic_1 entry) + FStar_Syntax_Embeddings.e_string + (FStar_Syntax_Embeddings.e_list + FStar_Reflection_V2_Embeddings.e_sigelt) psc ncb us args) \ No newline at end of file From 497a493f524b53f114ae334525ab69f902fa6c41 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Tue, 30 Apr 2024 00:06:50 -0700 Subject: [PATCH 155/239] Add a test --- tests/tactics/Test.TypeRepr.fst | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 tests/tactics/Test.TypeRepr.fst diff --git a/tests/tactics/Test.TypeRepr.fst b/tests/tactics/Test.TypeRepr.fst new file mode 100644 index 00000000000..bacceddd284 --- /dev/null +++ b/tests/tactics/Test.TypeRepr.fst @@ -0,0 +1,17 @@ +module Test.TypeRepr + +open FStar.Tactics.V2 +module TypeRepr = FStar.Tactics.TypeRepr + +type test1 (a:Type0) : Type u#123 = + | A of a + | B : bool -> int -> test1 a + | C : int -> string -> list bool -> test1 a + | D : int -> (int & bool) -> test1 a + +%splice[test1_repr; test1_down; test1_up] (TypeRepr.entry (`%test1)) + +let _ = assert (forall a (x:test1 a). test1_up (test1_down x) == x) + +[@@expect_failure] // fuel limitation +let _ = assert (forall a (x:test1_repr a). test1_down (test1_up x) == x) From 3849844bc62687983bce7c4775bd69f7fa212938 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Tue, 30 Apr 2024 19:58:19 -0700 Subject: [PATCH 156/239] Fix test First few were failing due to `is_inj` not being found. Use codes for all of them. --- tests/bug-reports/BugBoxInjectivity.fst | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/tests/bug-reports/BugBoxInjectivity.fst b/tests/bug-reports/BugBoxInjectivity.fst index 0651f1ea109..bad8361afc5 100644 --- a/tests/bug-reports/BugBoxInjectivity.fst +++ b/tests/bug-reports/BugBoxInjectivity.fst @@ -1,5 +1,8 @@ module BugBoxInjectivity +open FStar.Functions +module CC = FStar.Cardinality.Universes + //The original bug; using an indirection to subvert the injectivity check let mytype1 = Type u#1 @@ -10,7 +13,7 @@ let inj_my_t (#a:Type u#1) (x:my_t a) : Lemma (x == My #a) = () -[@@expect_failure] +[@@expect_failure [19]] let my_t_injective : squash (is_inj my_t) = introduce forall f0 f1. my_t f0 == my_t f1 ==> f0 == f1 @@ -28,7 +31,7 @@ let inj_t (#a:Type u#1) (x:t a) : Lemma (x == Mk #a) = () -[@@expect_failure] +[@@expect_failure [19]] let t_injective : squash (is_inj t) = introduce forall f0 f1. t f0 == t f1 ==> f0 == f1 @@ -38,8 +41,6 @@ let t_injective : squash (is_inj t) = inj_t #f1 (coerce_eq () (Mk #f0)) ) -open FStar.Functions -module CC = FStar.Cardinality.Universes //Disabling the injectivity check on parameters is inconsistent #push-options "--ext 'compat:injectivity'" noeq @@ -73,7 +74,7 @@ type ceq (#a:Type) x : a -> Type = let test a (x y:a) (h:ceq #a x y) : Lemma (x == y) = () //But without collapsing -[@expect_failure] +[@expect_failure [19]] let bad (h0:ceq true true) (h1:ceq false false) : Lemma (true == false) = let Refl = h0 in let Refl = h1 in @@ -89,7 +90,7 @@ noeq type test3 (a:idx) : Type u#1 = | Mk3 : test3 a -[@@expect_failure] +[@@expect_failure [19]] let eq_test3_should_fail (x0 : test3 A1) (x1 : test3 A2) : unit = assert (test3 A1 == test3 A2) @@ -97,14 +98,14 @@ let case0 (x0 : test3 A1) (x1 : test3 A2) : Lemma False = assume (test3 A1 == test3 A2); assume (~ (Mk3 #A1 == coerce_eq () (Mk3 #A2))) -[@@expect_failure] +[@@expect_failure [228]] let case1 (x0 : test3 A1) (x1 : test3 A2) : Lemma False = assume (test3 A1 == test3 A2); assert (~ (Mk3 #A1 == coerce_eq () (Mk3 #A2))) by (T.norm [delta;primops]; T.trefl ()) -[@@expect_failure] +[@@expect_failure [228]] let case2 (x0 : test3 A1) (x1 : test3 A2) : Lemma False = assume (test3 A1 == test3 A2); assert (~ (Mk3 #A1 == coerce_eq () (Mk3 #A2))) @@ -122,7 +123,7 @@ let case5 (x0 : test3 A1) (x1 : test3 A2) : Lemma (test3 A1 == test3 A2 ==> Mk3 assume (test3 A1 == test3 A2); assert (Mk3 #A1 == coerce_eq () (Mk3 #A2)) by (T.norm [delta;primops;nbe]; - T.trivial()) //this can be proven by the normalizer alone; nor by nbe + T.trivial()) //this can be proven by the normalizer alone; and by nbe let case6 (x0 : test3 A1) (x1 : test3 A2) : Lemma (test3 A1 == test3 A2 ==> Mk3 #A1 == coerce_eq () (Mk3 #A2)) = assume (test3 A1 == test3 A2); From 1e998e5ca704a3e6b5886869da89371cf949c830 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 2 May 2024 15:28:16 -0700 Subject: [PATCH 157/239] Primops: more refactoring into separate modules --- .../FStar.TypeChecker.Primops.Array.fst | 183 +++++++++++ .../FStar.TypeChecker.Primops.Array.fsti | 5 + .../FStar.TypeChecker.Primops.Issue.fst | 29 ++ .../FStar.TypeChecker.Primops.Issue.fsti | 5 + .../FStar.TypeChecker.Primops.Range.fst | 22 ++ .../FStar.TypeChecker.Primops.Range.fsti | 5 + .../FStar.TypeChecker.Primops.Sealed.fst | 102 +++++++ .../FStar.TypeChecker.Primops.Sealed.fsti | 5 + src/typechecker/FStar.TypeChecker.Primops.fst | 288 +----------------- .../FStar.TypeChecker.Primops.fsti | 3 +- 10 files changed, 364 insertions(+), 283 deletions(-) create mode 100644 src/typechecker/FStar.TypeChecker.Primops.Array.fst create mode 100644 src/typechecker/FStar.TypeChecker.Primops.Array.fsti create mode 100644 src/typechecker/FStar.TypeChecker.Primops.Issue.fst create mode 100644 src/typechecker/FStar.TypeChecker.Primops.Issue.fsti create mode 100644 src/typechecker/FStar.TypeChecker.Primops.Range.fst create mode 100644 src/typechecker/FStar.TypeChecker.Primops.Range.fsti create mode 100644 src/typechecker/FStar.TypeChecker.Primops.Sealed.fst create mode 100644 src/typechecker/FStar.TypeChecker.Primops.Sealed.fsti diff --git a/src/typechecker/FStar.TypeChecker.Primops.Array.fst b/src/typechecker/FStar.TypeChecker.Primops.Array.fst new file mode 100644 index 00000000000..5265b9020cd --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.Primops.Array.fst @@ -0,0 +1,183 @@ +module FStar.TypeChecker.Primops.Array + +open FStar +open FStar.Compiler +open FStar.Compiler.Effect +open FStar.Errors +open FStar.Class.Monad +open FStar.Syntax.Syntax +open FStar.Syntax.Embeddings + +open FStar.TypeChecker.Primops.Base + +module BU = FStar.Compiler.Util +module EMB = FStar.Syntax.Embeddings +module NBETerm = FStar.TypeChecker.NBETerm +module PC = FStar.Parser.Const +module S = FStar.Syntax.Syntax +module SS = FStar.Syntax.Subst +module U = FStar.Syntax.Util +module Z = FStar.BigInt + +let as_primitive_step is_strong (l, arity, u_arity, f, f_nbe) = + FStar.TypeChecker.Primops.Base.as_primitive_step_nbecbs is_strong (l, arity, u_arity, f, (fun cb univs args -> f_nbe univs args)) + +let arg_as_int (a:arg) : option Z.t = fst a |> try_unembed_simple + +let arg_as_list {|e:EMB.embedding 'a|} (a:arg) +: option (list 'a) + = fst a |> try_unembed_simple + +let mixed_binary_op + (as_a : arg -> option 'a) + (as_b : arg -> option 'b) + (embed_c : Range.range -> 'c -> term) + (f : Range.range -> universes -> 'a -> 'b -> option 'c) + (psc : psc) + (norm_cb : EMB.norm_cb) + (univs : universes) + (args : args) + : option term + = match args with + | [a;b] -> + begin + match as_a a, as_b b with + | Some a, Some b -> + (match f psc.psc_range univs a b with + | Some c -> Some (embed_c psc.psc_range c) + | _ -> None) + | _ -> None + end + | _ -> None + +let mixed_ternary_op + (as_a : arg -> option 'a) + (as_b : arg -> option 'b) + (as_c : arg -> option 'c) + (embed_d : Range.range -> 'd -> term) + (f : Range.range -> universes -> 'a -> 'b -> 'c -> option 'd) + (psc : psc) + (norm_cb : EMB.norm_cb) + (univs : universes) + (args : args) + : option term + = match args with + | [a;b;c] -> + begin + match as_a a, as_b b, as_c c with + | Some a, Some b, Some c -> + (match f psc.psc_range univs a b c with + | Some d -> Some (embed_d psc.psc_range d) + | _ -> None) + | _ -> None + end + | _ -> None + + +let bogus_cbs = { + NBETerm.iapp = (fun h _args -> h); + NBETerm.translate = (fun _ -> failwith "bogus_cbs translate"); +} + +let ops : list primitive_step = + let of_list_op = + let emb_typ t = ET_app(PC.immutable_array_t_lid |> Ident.string_of_lid, [t]) in + let un_lazy universes t l r = + S.mk_Tm_app + (S.mk_Tm_uinst (U.fvar_const PC.immutable_array_of_list_lid) universes) + [S.iarg t; S.as_arg l] + r + in + ( PC.immutable_array_of_list_lid, 2, 1, + mixed_binary_op + (fun (elt_t, _) -> Some elt_t) //the first arg of of_list is the element type + (fun (l, q) -> //2nd arg: try_unembed_simple as a list term + match arg_as_list #_ #FStar.Syntax.Embeddings.e_any (l, q) with + | Some lst -> Some (l, lst) + | _ -> None) + (fun r (universes, elt_t, (l, blob)) -> + //embed the result back as a Tm_lazy with the `ImmutableArray.t term` as the blob + //The kind records the type of the blob as IA.t "any" + //and the interesting thing here is that the thunk represents the blob back as pure F* term + //IA.of_list u#universes elt_t l. + //This unreduced representation can be used in a context where the blob doesn't make sense, + //e.g., in the SMT encoding, we represent the blob computed by of_list l + //just as the unreduced term `of_list l` + S.mk (Tm_lazy { blob; + lkind=Lazy_embedding (emb_typ EMB.(emb_typ_of _ #e_any ()), Thunk.mk (fun _ -> un_lazy universes elt_t l r)); + ltyp=S.mk_Tm_app (S.mk_Tm_uinst (U.fvar_const PC.immutable_array_t_lid) universes) [S.as_arg elt_t] r; + rng=r }) r) + (fun r universes elt_t (l, lst) -> + //The actual primitive step computing the IA.t blob + let blob = FStar.ImmutableArray.Base.of_list #term lst in + Some (universes, elt_t, (l, FStar.Compiler.Dyn.mkdyn blob))), + NBETerm.mixed_binary_op + (fun (elt_t, _) -> Some elt_t) + (fun (l, q) -> + match NBETerm.arg_as_list NBETerm.e_any (l, q) with + | None -> None + | Some lst -> Some (l, lst)) + (fun (universes, elt_t, (l, blob)) -> + //The embedding is similar to the non-NBE case + //But, this time the thunk is the NBE.t representation of `of_list l` + NBETerm.mk_t <| + NBETerm.Lazy (Inr (blob, emb_typ EMB.(emb_typ_of _ #e_any ())), + Thunk.mk (fun _ -> + NBETerm.mk_t <| NBETerm.FV (S.lid_as_fv PC.immutable_array_of_list_lid None, + universes, + [NBETerm.as_arg l])))) + (fun universes elt_t (l, lst) -> + let blob = FStar.ImmutableArray.Base.of_list #NBETerm.t lst in + Some (universes, elt_t, (l, FStar.Compiler.Dyn.mkdyn blob)))) + in + let arg1_as_elt_t (x:arg) : option term = Some (fst x) in + let arg2_as_blob (x:arg) : option FStar.Compiler.Dyn.dyn = + //try_unembed_simple an arg as a IA.t blob if the emb_typ + //of the lkind tells us it has the right type + match (SS.compress (fst x)).n with + | Tm_lazy {blob=blob; lkind=Lazy_embedding (ET_app(head, _), _)} + when head=Ident.string_of_lid PC.immutable_array_t_lid -> Some blob + | _ -> None + in + let arg2_as_blob_nbe (x:NBETerm.arg) : option FStar.Compiler.Dyn.dyn = + //try_unembed_simple an arg as a IA.t blob if the emb_typ + //tells us it has the right type + let open FStar.TypeChecker.NBETerm in + match (fst x).nbe_t with + | Lazy (Inr (blob, ET_app(head, _)), _) + when head=Ident.string_of_lid PC.immutable_array_t_lid -> Some blob + | _ -> None + in + let length_op = + let embed_int (r:Range.range) (i:Z.t) : term = embed_simple r i in + let run_op (blob:FStar.Compiler.Dyn.dyn) : option Z.t = + Some (BU.array_length #term (FStar.Compiler.Dyn.undyn blob)) + in + ( PC.immutable_array_length_lid, 2, 1, + mixed_binary_op arg1_as_elt_t //1st arg of length is the type + arg2_as_blob //2nd arg is the IA.t term blob + embed_int //the result is just an int, so embed it back + (fun _r _universes _ blob -> run_op blob), + //NBE case is similar + NBETerm.mixed_binary_op + (fun (elt_t, _) -> Some elt_t) + arg2_as_blob_nbe + (fun (i:Z.t) -> NBETerm.embed NBETerm.e_int bogus_cbs i) + (fun _universes _ blob -> run_op blob) ) + in + let index_op = + (PC.immutable_array_index_lid, 3, 1, + mixed_ternary_op arg1_as_elt_t //1st arg of index is the type + arg2_as_blob //2nd arg is the `IA.t term` blob + arg_as_int //3rd arg is an int + (fun r tm -> tm) //the result is just a term, so the embedding is the identity + (fun r _universes _t blob i -> Some (BU.array_index #term (FStar.Compiler.Dyn.undyn blob) i)), + NBETerm.mixed_ternary_op + (fun (elt_t, _) -> Some elt_t) + arg2_as_blob_nbe //2nd arg is an `IA.t NBEterm.t` blob + NBETerm.arg_as_int + (fun tm -> tm) //In this case, the result is a NBE.t, so embedding is the identity + (fun _universes _t blob i -> Some (BU.array_index #NBETerm.t (FStar.Compiler.Dyn.undyn blob) i))) + in + List.map (as_primitive_step true) + [of_list_op; length_op; index_op] diff --git a/src/typechecker/FStar.TypeChecker.Primops.Array.fsti b/src/typechecker/FStar.TypeChecker.Primops.Array.fsti new file mode 100644 index 00000000000..9026f882e67 --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.Primops.Array.fsti @@ -0,0 +1,5 @@ +module FStar.TypeChecker.Primops.Array + +open FStar.TypeChecker.Primops.Base + +val ops : list primitive_step diff --git a/src/typechecker/FStar.TypeChecker.Primops.Issue.fst b/src/typechecker/FStar.TypeChecker.Primops.Issue.fst new file mode 100644 index 00000000000..bbea2da7e4b --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.Primops.Issue.fst @@ -0,0 +1,29 @@ +module FStar.TypeChecker.Primops.Issue + +open FStar +open FStar.Compiler +open FStar.Compiler.Effect +open FStar.Errors +open FStar.Class.Monad + +open FStar.TypeChecker.Primops.Base + +module PC = FStar.Parser.Const +module Z = FStar.BigInt + +let ops : list primitive_step = + let mk_lid l = PC.p2l ["FStar"; "Issue"; l] in [ + mk1 0 (mk_lid "message_of_issue") Mkissue?.issue_msg; + mk1 0 (mk_lid "level_of_issue") (fun i -> Errors.string_of_issue_level i.issue_level); + mk1 0 (mk_lid "number_of_issue") (fun i -> fmap Z.of_int_fs i.issue_number); + mk1 0 (mk_lid "range_of_issue") Mkissue?.issue_range; + mk1 0 (mk_lid "context_of_issue") Mkissue?.issue_ctx; + mk1 0 (mk_lid "render_issue") Errors.format_issue; + mk5 0 (mk_lid "mk_issue_doc") (fun level msg range number context -> + { issue_level = Errors.issue_level_of_string level; + issue_range = range; + issue_number = fmap Z.to_int_fs number; + issue_msg = msg; + issue_ctx = context} + ); + ] diff --git a/src/typechecker/FStar.TypeChecker.Primops.Issue.fsti b/src/typechecker/FStar.TypeChecker.Primops.Issue.fsti new file mode 100644 index 00000000000..0c00810fca7 --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.Primops.Issue.fsti @@ -0,0 +1,5 @@ +module FStar.TypeChecker.Primops.Issue + +open FStar.TypeChecker.Primops.Base + +val ops : list primitive_step diff --git a/src/typechecker/FStar.TypeChecker.Primops.Range.fst b/src/typechecker/FStar.TypeChecker.Primops.Range.fst new file mode 100644 index 00000000000..512b2a34aa2 --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.Primops.Range.fst @@ -0,0 +1,22 @@ +module FStar.TypeChecker.Primops.Range + +open FStar +open FStar.Compiler +open FStar.Compiler.Effect +open FStar.Compiler.List +open FStar.Class.Monad + +open FStar.TypeChecker.Primops.Base +open FStar.Compiler.Range + +module PC = FStar.Parser.Const +module Z = FStar.BigInt + +(* Range ops *) + +let ops = [ + mk5 0 PC.mk_range_lid (fun fn from_l from_c to_l to_c -> + mk_range fn (mk_pos (Z.to_int_fs from_l) (Z.to_int_fs from_c)) + (mk_pos (Z.to_int_fs to_l) (Z.to_int_fs to_c)) + ); +] diff --git a/src/typechecker/FStar.TypeChecker.Primops.Range.fsti b/src/typechecker/FStar.TypeChecker.Primops.Range.fsti new file mode 100644 index 00000000000..484e936c99d --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.Primops.Range.fsti @@ -0,0 +1,5 @@ +module FStar.TypeChecker.Primops.Range + +open FStar.TypeChecker.Primops.Base + +val ops : list primitive_step diff --git a/src/typechecker/FStar.TypeChecker.Primops.Sealed.fst b/src/typechecker/FStar.TypeChecker.Primops.Sealed.fst new file mode 100644 index 00000000000..6e3e0e480ab --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.Primops.Sealed.fst @@ -0,0 +1,102 @@ +module FStar.TypeChecker.Primops.Sealed + +open FStar +open FStar.Compiler +open FStar.Compiler.Effect +open FStar.Syntax.Syntax + +open FStar.TypeChecker.Primops.Base + +module EMB = FStar.Syntax.Embeddings +module NBETerm = FStar.TypeChecker.NBETerm +module PC = FStar.Parser.Const +module S = FStar.Syntax.Syntax +module U = FStar.Syntax.Util + +let bogus_cbs = { + NBETerm.iapp = (fun h _args -> h); + NBETerm.translate = (fun _ -> failwith "bogus_cbs translate"); +} + +let ops = + List.map (fun p -> { as_primitive_step_nbecbs true p with renorm_after = true}) [ + (PC.map_seal_lid, 4, 2, + (fun psc univs cbs args -> + match args with + | [(ta, _); (tb, _); (s, _); (f, _)] -> + begin + let open EMB in + let try_unembed (#a:Type) (e:embedding a) (x:term) : option a = + try_unembed x id_norm_cb + in + match try_unembed e_any ta, + try_unembed e_any tb, + try_unembed (e_sealed e_any) s, + try_unembed e_any f with + | Some ta, Some tb, Some s, Some f -> + let r = U.mk_app f [S.as_arg (Sealed.unseal s)] in + let emb = set_type ta e_any in + Some (embed_simple psc.psc_range (Sealed.seal r)) + | _ -> None + end + | _ -> None), + (fun cb univs args -> + match args with + | [(ta, _); (tb, _); (s, _); (f, _)] -> + begin + let open FStar.TypeChecker.NBETerm in + let try_unembed (#a:Type) (e:embedding a) (x:NBETerm.t) : option a = + unembed e bogus_cbs x + in + match try_unembed e_any ta, + try_unembed e_any tb, + try_unembed (e_sealed e_any) s, + try_unembed e_any f with + | Some ta, Some tb, Some s, Some f -> + let r = cb.iapp f [as_arg (Sealed.unseal s)] in + let emb = set_type ta e_any in + Some (embed (e_sealed emb) cb (Sealed.seal r)) + | _ -> None + end + | _ -> None + )); + (PC.bind_seal_lid, 4, 2, + (fun psc univs cbs args -> + match args with + | [(ta, _); (tb, _); (s, _); (f, _)] -> + begin + let open EMB in + let try_unembed (#a:Type) (e:embedding a) (x:term) : option a = + try_unembed x id_norm_cb + in + match try_unembed e_any ta, + try_unembed e_any tb, + try_unembed (e_sealed e_any) s, + try_unembed e_any f with + | Some ta, Some tb, Some s, Some f -> + let r = U.mk_app f [S.as_arg (Sealed.unseal s)] in + Some (embed_simple #_ #e_any psc.psc_range r) + | _ -> None + end + | _ -> None), + (fun cb univs args -> + match args with + | [(ta, _); (tb, _); (s, _); (f, _)] -> + begin + let open FStar.TypeChecker.NBETerm in + let try_unembed (#a:Type) (e:embedding a) (x:NBETerm.t) : option a = + unembed e bogus_cbs x + in + match try_unembed e_any ta, + try_unembed e_any tb, + try_unembed (e_sealed e_any) s, + try_unembed e_any f with + | Some ta, Some tb, Some s, Some f -> + let r = cb.iapp f [as_arg (Sealed.unseal s)] in + let emb = set_type ta e_any in + Some (embed emb cb r) + | _ -> None + end + | _ -> None + )); + ] diff --git a/src/typechecker/FStar.TypeChecker.Primops.Sealed.fsti b/src/typechecker/FStar.TypeChecker.Primops.Sealed.fsti new file mode 100644 index 00000000000..5c590c15a8f --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.Primops.Sealed.fsti @@ -0,0 +1,5 @@ +module FStar.TypeChecker.Primops.Sealed + +open FStar.TypeChecker.Primops.Base + +val ops : list primitive_step diff --git a/src/typechecker/FStar.TypeChecker.Primops.fst b/src/typechecker/FStar.TypeChecker.Primops.fst index ce52eb5fc71..5ad46485a33 100644 --- a/src/typechecker/FStar.TypeChecker.Primops.fst +++ b/src/typechecker/FStar.TypeChecker.Primops.fst @@ -3,31 +3,20 @@ module FStar.TypeChecker.Primops (* This module just contains the list of all builtin primitive steps with their implementations. *) -open FStar.Compiler.Effect -open FStar.Compiler.List open FStar open FStar.Compiler +open FStar.Compiler.Effect +open FStar.Compiler.List open FStar.String -open FStar.Const -open FStar.Char open FStar.Syntax open FStar.Syntax.Syntax -open FStar.TypeChecker -open FStar.TypeChecker.Env -open FStar.Errors open FStar.Class.Monad -open FStar.Class.Show module S = FStar.Syntax.Syntax -module SS = FStar.Syntax.Subst module BU = FStar.Compiler.Util -module FC = FStar.Const module PC = FStar.Parser.Const -module U = FStar.Syntax.Util -module I = FStar.Ident module EMB = FStar.Syntax.Embeddings module Z = FStar.BigInt -module NBE = FStar.TypeChecker.NBETerm open FStar.TypeChecker.Primops.Base @@ -35,61 +24,10 @@ open FStar.TypeChecker.Primops.Base (* Semantics for primitive operators (+, -, >, &&, ...) *) (*******************************************************************) -let arg_as_int (a:arg) : option Z.t = fst a |> try_unembed_simple - -let arg_as_list {|e:EMB.embedding 'a|} (a:arg) -: option (list 'a) - = fst a |> try_unembed_simple - (* Most primitive steps don't use the NBE cbs, so they can use this wrapper. *) let as_primitive_step is_strong (l, arity, u_arity, f, f_nbe) = Primops.Base.as_primitive_step_nbecbs is_strong (l, arity, u_arity, f, (fun cb univs args -> f_nbe univs args)) -let mixed_binary_op - (as_a : arg -> option 'a) - (as_b : arg -> option 'b) - (embed_c : Range.range -> 'c -> term) - (f : Range.range -> universes -> 'a -> 'b -> option 'c) - (psc : psc) - (norm_cb : EMB.norm_cb) - (univs : universes) - (args : args) - : option term - = match args with - | [a;b] -> - begin - match as_a a, as_b b with - | Some a, Some b -> - (match f psc.psc_range univs a b with - | Some c -> Some (embed_c psc.psc_range c) - | _ -> None) - | _ -> None - end - | _ -> None - -let mixed_ternary_op - (as_a : arg -> option 'a) - (as_b : arg -> option 'b) - (as_c : arg -> option 'c) - (embed_d : Range.range -> 'd -> term) - (f : Range.range -> universes -> 'a -> 'b -> 'c -> option 'd) - (psc : psc) - (norm_cb : EMB.norm_cb) - (univs : universes) - (args : args) - : option term - = match args with - | [a;b;c] -> - begin - match as_a a, as_b b, as_c c with - | Some a, Some b, Some c -> - (match f psc.psc_range univs a b c with - | Some d -> Some (embed_d psc.psc_range d) - | _ -> None) - | _ -> None - end - | _ -> None - (* and_op and or_op are special cased because they are short-circuting, * can run without unembedding its second argument. *) let and_op : psc -> EMB.norm_cb -> universes -> args -> option term @@ -167,223 +105,8 @@ let simple_ops : list primitive_step = [ mk2 0 PC.string_index_lid String.index; mk2 0 PC.string_index_of_lid String.index_of; mk3 0 PC.string_sub_lid (fun s o l -> String.substring s (Z.to_int_fs o) (Z.to_int_fs l)); - - (* Range ops *) - mk5 0 PC.mk_range_lid (fun fn from_l from_c to_l to_c -> - let open FStar.Compiler.Range in - mk_range fn (mk_pos (Z.to_int_fs from_l) (Z.to_int_fs from_c)) - (mk_pos (Z.to_int_fs to_l) (Z.to_int_fs to_c)) - ); ] -let bogus_cbs = { - NBE.iapp = (fun h _args -> h); - NBE.translate = (fun _ -> failwith "bogus_cbs translate"); -} - -let issue_ops : list primitive_step = - let mk_lid l = PC.p2l ["FStar"; "Issue"; l] in [ - mk1 0 (mk_lid "message_of_issue") Mkissue?.issue_msg; - mk1 0 (mk_lid "level_of_issue") (fun i -> Errors.string_of_issue_level i.issue_level); - mk1 0 (mk_lid "number_of_issue") (fun i -> fmap Z.of_int_fs i.issue_number); - mk1 0 (mk_lid "range_of_issue") Mkissue?.issue_range; - mk1 0 (mk_lid "context_of_issue") Mkissue?.issue_ctx; - mk1 0 (mk_lid "render_issue") Errors.format_issue; - mk5 0 (mk_lid "mk_issue_doc") (fun level msg range number context -> - { issue_level = Errors.issue_level_of_string level; - issue_range = range; - issue_number = fmap Z.to_int_fs number; - issue_msg = msg; - issue_ctx = context} - ); - ] - -let seal_steps = - List.map (fun p -> { as_primitive_step_nbecbs true p with renorm_after = true}) [ - (PC.map_seal_lid, 4, 2, - (fun psc univs cbs args -> - match args with - | [(ta, _); (tb, _); (s, _); (f, _)] -> - begin - let open EMB in - let try_unembed (#a:Type) (e:embedding a) (x:term) : option a = - try_unembed x id_norm_cb - in - match try_unembed e_any ta, - try_unembed e_any tb, - try_unembed (e_sealed e_any) s, - try_unembed e_any f with - | Some ta, Some tb, Some s, Some f -> - let r = U.mk_app f [S.as_arg (Sealed.unseal s)] in - let emb = set_type ta e_any in - Some (embed_simple psc.psc_range (Sealed.seal r)) - | _ -> None - end - | _ -> None), - (fun cb univs args -> - match args with - | [(ta, _); (tb, _); (s, _); (f, _)] -> - begin - let open FStar.TypeChecker.NBETerm in - let try_unembed (#a:Type) (e:embedding a) (x:NBETerm.t) : option a = - unembed e bogus_cbs x - in - match try_unembed e_any ta, - try_unembed e_any tb, - try_unembed (e_sealed e_any) s, - try_unembed e_any f with - | Some ta, Some tb, Some s, Some f -> - let r = cb.iapp f [as_arg (Sealed.unseal s)] in - let emb = set_type ta e_any in - Some (embed (e_sealed emb) cb (Sealed.seal r)) - | _ -> None - end - | _ -> None - )); - (PC.bind_seal_lid, 4, 2, - (fun psc univs cbs args -> - match args with - | [(ta, _); (tb, _); (s, _); (f, _)] -> - begin - let open EMB in - let try_unembed (#a:Type) (e:embedding a) (x:term) : option a = - try_unembed x id_norm_cb - in - match try_unembed e_any ta, - try_unembed e_any tb, - try_unembed (e_sealed e_any) s, - try_unembed e_any f with - | Some ta, Some tb, Some s, Some f -> - let r = U.mk_app f [S.as_arg (Sealed.unseal s)] in - Some (embed_simple #_ #e_any psc.psc_range r) - | _ -> None - end - | _ -> None), - (fun cb univs args -> - match args with - | [(ta, _); (tb, _); (s, _); (f, _)] -> - begin - let open FStar.TypeChecker.NBETerm in - let try_unembed (#a:Type) (e:embedding a) (x:NBETerm.t) : option a = - unembed e bogus_cbs x - in - match try_unembed e_any ta, - try_unembed e_any tb, - try_unembed (e_sealed e_any) s, - try_unembed e_any f with - | Some ta, Some tb, Some s, Some f -> - let r = cb.iapp f [as_arg (Sealed.unseal s)] in - let emb = set_type ta e_any in - Some (embed emb cb r) - | _ -> None - end - | _ -> None - )); - ] - - let array_ops : list primitive_step = - let of_list_op = - let emb_typ t = ET_app(PC.immutable_array_t_lid |> Ident.string_of_lid, [t]) in - let un_lazy universes t l r = - S.mk_Tm_app - (S.mk_Tm_uinst (U.fvar_const PC.immutable_array_of_list_lid) universes) - [S.iarg t; S.as_arg l] - r - in - ( PC.immutable_array_of_list_lid, 2, 1, - mixed_binary_op - (fun (elt_t, _) -> Some elt_t) //the first arg of of_list is the element type - (fun (l, q) -> //2nd arg: try_unembed_simple as a list term - match arg_as_list #_ #FStar.Syntax.Embeddings.e_any (l, q) with - | Some lst -> Some (l, lst) - | _ -> None) - (fun r (universes, elt_t, (l, blob)) -> - //embed the result back as a Tm_lazy with the `ImmutableArray.t term` as the blob - //The kind records the type of the blob as IA.t "any" - //and the interesting thing here is that the thunk represents the blob back as pure F* term - //IA.of_list u#universes elt_t l. - //This unreduced representation can be used in a context where the blob doesn't make sense, - //e.g., in the SMT encoding, we represent the blob computed by of_list l - //just as the unreduced term `of_list l` - S.mk (Tm_lazy { blob; - lkind=Lazy_embedding (emb_typ EMB.(emb_typ_of _ #e_any ()), Thunk.mk (fun _ -> un_lazy universes elt_t l r)); - ltyp=S.mk_Tm_app (S.mk_Tm_uinst (U.fvar_const PC.immutable_array_t_lid) universes) [S.as_arg elt_t] r; - rng=r }) r) - (fun r universes elt_t (l, lst) -> - //The actual primitive step computing the IA.t blob - let blob = FStar.ImmutableArray.Base.of_list #term lst in - Some (universes, elt_t, (l, FStar.Compiler.Dyn.mkdyn blob))), - NBETerm.mixed_binary_op - (fun (elt_t, _) -> Some elt_t) - (fun (l, q) -> - match NBETerm.arg_as_list NBETerm.e_any (l, q) with - | None -> None - | Some lst -> Some (l, lst)) - (fun (universes, elt_t, (l, blob)) -> - //The embedding is similar to the non-NBE case - //But, this time the thunk is the NBE.t representation of `of_list l` - NBETerm.mk_t <| - NBETerm.Lazy (Inr (blob, emb_typ EMB.(emb_typ_of _ #e_any ())), - Thunk.mk (fun _ -> - NBETerm.mk_t <| NBETerm.FV (S.lid_as_fv PC.immutable_array_of_list_lid None, - universes, - [NBETerm.as_arg l])))) - (fun universes elt_t (l, lst) -> - let blob = FStar.ImmutableArray.Base.of_list #NBETerm.t lst in - Some (universes, elt_t, (l, FStar.Compiler.Dyn.mkdyn blob)))) - in - let arg1_as_elt_t (x:arg) : option term = Some (fst x) in - let arg2_as_blob (x:arg) : option FStar.Compiler.Dyn.dyn = - //try_unembed_simple an arg as a IA.t blob if the emb_typ - //of the lkind tells us it has the right type - match (SS.compress (fst x)).n with - | Tm_lazy {blob=blob; lkind=Lazy_embedding (ET_app(head, _), _)} - when head=Ident.string_of_lid PC.immutable_array_t_lid -> Some blob - | _ -> None - in - let arg2_as_blob_nbe (x:NBETerm.arg) : option FStar.Compiler.Dyn.dyn = - //try_unembed_simple an arg as a IA.t blob if the emb_typ - //tells us it has the right type - let open FStar.TypeChecker.NBETerm in - match (fst x).nbe_t with - | Lazy (Inr (blob, ET_app(head, _)), _) - when head=Ident.string_of_lid PC.immutable_array_t_lid -> Some blob - | _ -> None - in - let length_op = - let embed_int (r:Range.range) (i:Z.t) : term = embed_simple r i in - let run_op (blob:FStar.Compiler.Dyn.dyn) : option Z.t = - Some (BU.array_length #term (FStar.Compiler.Dyn.undyn blob)) - in - ( PC.immutable_array_length_lid, 2, 1, - mixed_binary_op arg1_as_elt_t //1st arg of length is the type - arg2_as_blob //2nd arg is the IA.t term blob - embed_int //the result is just an int, so embed it back - (fun _r _universes _ blob -> run_op blob), - //NBE case is similar - NBETerm.mixed_binary_op - (fun (elt_t, _) -> Some elt_t) - arg2_as_blob_nbe - (fun (i:Z.t) -> NBETerm.embed NBETerm.e_int bogus_cbs i) - (fun _universes _ blob -> run_op blob) ) - in - let index_op = - (PC.immutable_array_index_lid, 3, 1, - mixed_ternary_op arg1_as_elt_t //1st arg of index is the type - arg2_as_blob //2nd arg is the `IA.t term` blob - arg_as_int //3rd arg is an int - (fun r tm -> tm) //the result is just a term, so the embedding is the identity - (fun r _universes _t blob i -> Some (BU.array_index #term (FStar.Compiler.Dyn.undyn blob) i)), - NBETerm.mixed_ternary_op - (fun (elt_t, _) -> Some elt_t) - arg2_as_blob_nbe //2nd arg is an `IA.t NBEterm.t` blob - NBETerm.arg_as_int - (fun tm -> tm) //In this case, the result is a NBE.t, so embedding is the identity - (fun _universes _t blob i -> Some (BU.array_index #NBETerm.t (FStar.Compiler.Dyn.undyn blob) i))) - in - List.map (as_primitive_step true) - [of_list_op; length_op; index_op] - let short_circuit_ops : list primitive_step = List.map (as_primitive_step true) [ @@ -394,13 +117,14 @@ let short_circuit_ops : list primitive_step = let built_in_primitive_steps_list : list primitive_step = simple_ops @ short_circuit_ops - @ issue_ops - @ array_ops - @ seal_steps + @ Primops.Issue.ops + @ Primops.Array.ops + @ Primops.Sealed.ops @ Primops.Erased.ops @ Primops.Docs.ops @ Primops.MachineInts.ops @ Primops.Errors.Msg.ops + @ Primops.Range.ops let equality_ops_list env : list primitive_step = Primops.Eq.prop_eq_ops env diff --git a/src/typechecker/FStar.TypeChecker.Primops.fsti b/src/typechecker/FStar.TypeChecker.Primops.fsti index 39cca74551f..7d8faad331c 100644 --- a/src/typechecker/FStar.TypeChecker.Primops.fsti +++ b/src/typechecker/FStar.TypeChecker.Primops.fsti @@ -1,5 +1,6 @@ module FStar.TypeChecker.Primops +open FStar.Compiler.Effect include FStar.TypeChecker.Primops.Base (* This module just contains the list of all builtin primitive steps @@ -7,4 +8,4 @@ with their implementations. *) val built_in_primitive_steps_list : list primitive_step val equality_ops_list (env:Env.env_t) : list primitive_step -val env_dependent_ops (env:Env.env_t) : list primitive_step \ No newline at end of file +val env_dependent_ops (env:Env.env_t) : list primitive_step From f46f0c8e8f6692fdc05e6b74bd4995dae710fc74 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 2 May 2024 15:29:16 -0700 Subject: [PATCH 158/239] FStar.Range: add a join_range operation --- ocaml/fstar-lib/FStar_Range.ml | 3 ++- src/parser/FStar.Parser.Const.fst | 1 + src/typechecker/FStar.TypeChecker.Primops.Range.fst | 2 ++ ulib/FStar.Range.fsti | 2 ++ 4 files changed, 7 insertions(+), 1 deletion(-) diff --git a/ocaml/fstar-lib/FStar_Range.ml b/ocaml/fstar-lib/FStar_Range.ml index cbd5b447224..0451f197f82 100644 --- a/ocaml/fstar-lib/FStar_Range.ml +++ b/ocaml/fstar-lib/FStar_Range.ml @@ -3,5 +3,6 @@ type range = __range let mk_range f a b c d = FStar_Compiler_Range_Type.mk_range f {line=a;col=b} {line=c;col=d} let range_0 : range = let z = Prims.parse_int "0" in mk_range "dummy" z z z z +let join_range r1 r2 = FStar_Compiler_Range_Ops.union_ranges r1 r2 -type ('Ar,'Amsg,'Ab) labeled = 'Ab \ No newline at end of file +type ('Ar,'Amsg,'Ab) labeled = 'Ab diff --git a/src/parser/FStar.Parser.Const.fst b/src/parser/FStar.Parser.Const.fst index 2be80c76f51..28a8e08bf7a 100644 --- a/src/parser/FStar.Parser.Const.fst +++ b/src/parser/FStar.Parser.Const.fst @@ -314,6 +314,7 @@ let __range_lid = p2l ["FStar"; "Range"; "__range"] let range_lid = p2l ["FStar"; "Range"; "range"] (* this is a sealed version of the above *) let range_0 = p2l ["FStar"; "Range"; "range_0"] let mk_range_lid = p2l ["FStar"; "Range"; "mk_range"] +let join_range_lid = p2l ["FStar"; "Range"; "join_range"] let guard_free = pconst "guard_free" let inversion_lid = p2l ["FStar"; "Pervasives"; "inversion"] diff --git a/src/typechecker/FStar.TypeChecker.Primops.Range.fst b/src/typechecker/FStar.TypeChecker.Primops.Range.fst index 512b2a34aa2..d38193d6da5 100644 --- a/src/typechecker/FStar.TypeChecker.Primops.Range.fst +++ b/src/typechecker/FStar.TypeChecker.Primops.Range.fst @@ -19,4 +19,6 @@ let ops = [ mk_range fn (mk_pos (Z.to_int_fs from_l) (Z.to_int_fs from_c)) (mk_pos (Z.to_int_fs to_l) (Z.to_int_fs to_c)) ); + + mk2 0 PC.join_range_lid FStar.Compiler.Range.union_ranges; ] diff --git a/ulib/FStar.Range.fsti b/ulib/FStar.Range.fsti index bf196888d89..c44506b68df 100644 --- a/ulib/FStar.Range.fsti +++ b/ulib/FStar.Range.fsti @@ -32,6 +32,8 @@ val range_0 : range (** Building a range constant *) val mk_range (file: string) (from_line from_col to_line to_col: int) : Tot range +val join_range (r1 r2 : range) : Tot range + (** [labeled] is used internally to the SMT encoding to associate a source-code location with an assertion. *) irreducible From cfb209d8974759aaf1de94f626d26929e8614c63 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 2 May 2024 15:36:09 -0700 Subject: [PATCH 159/239] Format some errors --- src/typechecker/FStar.TypeChecker.Err.fst | 21 ++++++++++++------- .../FStar.TypeChecker.Normalize.fst | 7 +++++++ .../FStar.TypeChecker.Normalize.fsti | 1 + src/typechecker/FStar.TypeChecker.Util.fst | 4 ++-- 4 files changed, 23 insertions(+), 10 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.Err.fst b/src/typechecker/FStar.TypeChecker.Err.fst index d0717b5ed19..ccf1a9f1e1c 100644 --- a/src/typechecker/FStar.TypeChecker.Err.fst +++ b/src/typechecker/FStar.TypeChecker.Err.fst @@ -263,18 +263,23 @@ let name_and_result c = match c.n with | Comp ct -> Print.lid_to_string ct.effect_name, ct.result_typ let computed_computation_type_does_not_match_annotation env e c c' = + let ppt = N.term_to_doc env in let f1, r1 = name_and_result c in let f2, r2 = name_and_result c' in - let s1, s2 = err_msg_type_strings env r1 r2 in - (Errors.Fatal_ComputedTypeNotMatchAnnotation, (format4 - "Computed type \"%s\" and effect \"%s\" is not compatible with the annotated type \"%s\" effect \"%s\"" - s1 f1 s2 f2)) + (Errors.Fatal_ComputedTypeNotMatchAnnotation, [ + prefix 2 1 (text "Computed type") (ppt r1) ^/^ + prefix 2 1 (text "and effect") (text f1) ^/^ + prefix 2 1 (text "is not compatible with the annotated type") (ppt r2) ^/^ + prefix 2 1 (text "and effect") (text f2) + ]) let computed_computation_type_does_not_match_annotation_eq env e c c' = - let s1, s2 = err_msg_comp_strings env c c' in - (Errors.Fatal_ComputedTypeNotMatchAnnotation, (format2 - "Computed type \"%s\" does not match annotated type \"%s\", and no subtyping was allowed" - s1 s2)) + let ppc = N.comp_to_doc env in + (Errors.Fatal_ComputedTypeNotMatchAnnotation, ([ + prefix 2 1 (text "Computed type") (ppc c) ^/^ + prefix 2 1 (text "does not match annotated type") (ppc c') ^/^ + text "and no subtyping was allowed"; + ])) let unexpected_non_trivial_precondition_on_term env f = (Errors.Fatal_UnExpectedPreCondition, (format1 "Term has an unexpected non-trivial pre-condition: %s" (N.term_to_string env f))) diff --git a/src/typechecker/FStar.TypeChecker.Normalize.fst b/src/typechecker/FStar.TypeChecker.Normalize.fst index a28eb99dd0e..e576d208104 100644 --- a/src/typechecker/FStar.TypeChecker.Normalize.fst +++ b/src/typechecker/FStar.TypeChecker.Normalize.fst @@ -3203,6 +3203,13 @@ let comp_to_string env c = GenSym.with_frozen_gensym (fun () -> in Print.comp_to_string' (DsEnv.set_current_module env.dsenv env.curmodule) c) +let comp_to_doc env c = GenSym.with_frozen_gensym (fun () -> + let c = + try norm_comp (config [AllowUnboundUniverses] env) [] c + with e -> Errors.log_issue c.pos (Errors.Warning_NormalizationFailure, (BU.format1 "Normalization failed with error %s\n" (BU.message_of_exn e))) ; c + in + Print.comp_to_doc' (DsEnv.set_current_module env.dsenv env.curmodule) c) + let normalize_refinement steps env t0 = let t = normalize (steps@[Beta]) env t0 in U.flatten_refinement t diff --git a/src/typechecker/FStar.TypeChecker.Normalize.fsti b/src/typechecker/FStar.TypeChecker.Normalize.fsti index df706f61092..d79f5599b0b 100644 --- a/src/typechecker/FStar.TypeChecker.Normalize.fsti +++ b/src/typechecker/FStar.TypeChecker.Normalize.fsti @@ -56,6 +56,7 @@ val normalize_with_primitive_steps : list Primops.primitive_step -> steps -> Env val term_to_string: Env.env -> term -> string val term_to_doc: Env.env -> term -> Pprint.document val comp_to_string: Env.env -> comp -> string +val comp_to_doc: Env.env -> comp -> Pprint.document val elim_uvars: Env.env -> sigelt -> sigelt val erase_universes: Env.env -> term -> term diff --git a/src/typechecker/FStar.TypeChecker.Util.fst b/src/typechecker/FStar.TypeChecker.Util.fst index 4dd0eea1242..4a7c4a3eaa7 100644 --- a/src/typechecker/FStar.TypeChecker.Util.fst +++ b/src/typechecker/FStar.TypeChecker.Util.fst @@ -2269,8 +2269,8 @@ let check_comp env (use_eq:bool) (e:term) (c:comp) (c':comp) : term * comp * gua match f env c c' with | None -> if use_eq - then raise_error (Err.computed_computation_type_does_not_match_annotation_eq env e c c') (Env.get_range env) - else raise_error (Err.computed_computation_type_does_not_match_annotation env e c c') (Env.get_range env) + then raise_error_doc (Err.computed_computation_type_does_not_match_annotation_eq env e c c') (Env.get_range env) + else raise_error_doc (Err.computed_computation_type_does_not_match_annotation env e c c') (Env.get_range env) | Some g -> e, c', g let universe_of_comp env u_res c = From 6450e1de6a1576670cd42d377f9c61d6305c5d4c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 2 May 2024 23:21:35 -0700 Subject: [PATCH 160/239] Update expected output --- tests/error-messages/Coercions.fst.expected | 10 ++++++++-- tests/error-messages/Erasable.fst.expected | 10 ++++++++-- tests/error-messages/GhostImplicits.fst.expected | 5 ++++- 3 files changed, 20 insertions(+), 5 deletions(-) diff --git a/tests/error-messages/Coercions.fst.expected b/tests/error-messages/Coercions.fst.expected index 97a2a36f3b7..e9de7cebab4 100644 --- a/tests/error-messages/Coercions.fst.expected +++ b/tests/error-messages/Coercions.fst.expected @@ -1,11 +1,17 @@ >> Got issues: [ * Error 34 at Coercions.fst(6,38-6,39): - - Computed type "Prims.int" and effect "GTot" is not compatible with the annotated type "Prims.int" effect "Tot" + - Computed type Prims.int + and effect GTot + is not compatible with the annotated type Prims.int + and effect Tot >>] >> Got issues: [ * Error 34 at Coercions.fst(19,37-19,38): - - Computed type "'a" and effect "GTot" is not compatible with the annotated type "'a" effect "Tot" + - Computed type 'a + and effect GTot + is not compatible with the annotated type 'a + and effect Tot >>] >> Got issues: [ diff --git a/tests/error-messages/Erasable.fst.expected b/tests/error-messages/Erasable.fst.expected index 46c3c5ad118..d6068bb7848 100644 --- a/tests/error-messages/Erasable.fst.expected +++ b/tests/error-messages/Erasable.fst.expected @@ -6,12 +6,18 @@ >>] >> Got issues: [ * Error 34 at Erasable.fst(18,2-20,15): - - Computed type "Prims.int" and effect "GHOST" is not compatible with the annotated type "Prims.int" effect "Tot" + - Computed type Prims.int + and effect GHOST + is not compatible with the annotated type Prims.int + and effect Tot >>] >> Got issues: [ * Error 34 at Erasable.fst(28,42-28,52): - - Computed type "Prims.int" and effect "GTot" is not compatible with the annotated type "Prims.int" effect "Tot" + - Computed type Prims.int + and effect GTot + is not compatible with the annotated type Prims.int + and effect Tot >>] >> Got issues: [ diff --git a/tests/error-messages/GhostImplicits.fst.expected b/tests/error-messages/GhostImplicits.fst.expected index e488d256774..b45255a2634 100644 --- a/tests/error-messages/GhostImplicits.fst.expected +++ b/tests/error-messages/GhostImplicits.fst.expected @@ -1,6 +1,9 @@ >> Got issues: [ * Error 34 at GhostImplicits.fst(25,54-25,57): - - Computed type "Prims.nat" and effect "GHOST" is not compatible with the annotated type "Prims.nat" effect "Tot" + - Computed type Prims.nat + and effect GHOST + is not compatible with the annotated type Prims.nat + and effect Tot >>] Verified module: GhostImplicits From 1a54022870974c3dbb818b81bf0caaf104c83f22 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 2 May 2024 16:13:56 -0700 Subject: [PATCH 161/239] Options: fix --debug, comma separated --- src/basic/FStar.Options.fst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/basic/FStar.Options.fst b/src/basic/FStar.Options.fst index 1a26ccd9311..9fe650ccfaf 100644 --- a/src/basic/FStar.Options.fst +++ b/src/basic/FStar.Options.fst @@ -1938,7 +1938,7 @@ let use_nbe_for_extraction () = get_use_nbe_for_extraction () let trivial_pre_for_unannotated_effectful_fns () = get_trivial_pre_for_unannotated_effectful_fns () -let debug_keys () = lookup_opt "debug" (as_list as_string) +let debug_keys () = lookup_opt "debug" as_comma_string_list let debug_all_modules () = lookup_opt "debug_all_modules" as_bool let with_saved_options f = From 72ee22fd12a53b8f28465d288299d5464c5cdaca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 2 May 2024 23:42:19 -0700 Subject: [PATCH 162/239] Resugar: fix #3227 --- src/syntax/FStar.Syntax.Resugar.fst | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/src/syntax/FStar.Syntax.Resugar.fst b/src/syntax/FStar.Syntax.Resugar.fst index fa00ec02b61..fd1857093a4 100644 --- a/src/syntax/FStar.Syntax.Resugar.fst +++ b/src/syntax/FStar.Syntax.Resugar.fst @@ -442,6 +442,34 @@ let rec resugar_term' (env: DsEnv.env) (t : S.term) : A.term = if Options.print_implicits () then args else filter_imp_args args in + + let is_projector (t:S.term) : option (lident & ident) = + (* Detect projectors and resugar them as t.x instead of Mkt?.x t *) + match (U.un_uinst (SS.compress t)).n with + | Tm_fvar fv -> + let a = fv.fv_name.v in + let length = String.length (nsstr fv.fv_name.v) in + let s = if length=0 then string_of_lid a + else BU.substring_from (string_of_lid a) (length+1) in + if BU.starts_with s U.field_projector_prefix then + let rest = BU.substring_from s (String.length U.field_projector_prefix) in + let r = BU.split rest U.field_projector_sep in + begin match r with + | [fst; snd] -> + let l = lid_of_path [fst] t.pos in + let r = I.mk_ident (snd, t.pos) in + Some (l, r) + | _ -> + failwith "wrong projector format" + end + else None + | _ -> None + in + if Some? (is_projector e) && List.length args = 1 then + let (_, fi) = Some?.v (is_projector e) in + let arg = resugar_term' env (fst (List.hd args)) in + mk <| Project (arg, Ident.lid_of_ids [fi]) + else begin match resugar_term_as_op e with | None-> resugar_as_app e args From 4892e052404a7b55bab0eb486645cbacc8432007 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 2 May 2024 23:50:54 -0700 Subject: [PATCH 163/239] Add test for #3227 --- tests/error-messages/Bug3227.fst | 8 +++ tests/error-messages/Bug3227.fst.expected | 83 +++++++++++++++++++++++ tests/error-messages/Makefile | 3 + 3 files changed, 94 insertions(+) create mode 100644 tests/error-messages/Bug3227.fst create mode 100644 tests/error-messages/Bug3227.fst.expected diff --git a/tests/error-messages/Bug3227.fst b/tests/error-messages/Bug3227.fst new file mode 100644 index 00000000000..946f145490d --- /dev/null +++ b/tests/error-messages/Bug3227.fst @@ -0,0 +1,8 @@ +module Bug3227 + +type box (a:Type) = { x : a; } +let proj (b : box (box (box int))) : int = b.x.x.x + +type box2 (a:Type) = | Box2 : x:a -> box2 a + +let test (b : box2 (box2 int)) = Box2? b && Box2? (Box2?.x b) \ No newline at end of file diff --git a/tests/error-messages/Bug3227.fst.expected b/tests/error-messages/Bug3227.fst.expected new file mode 100644 index 00000000000..4a4a9d19016 --- /dev/null +++ b/tests/error-messages/Bug3227.fst.expected @@ -0,0 +1,83 @@ +Module after desugaring: +module Bug3227 +Declarations: [ +type box (a: Type) = { } + +let proj b = x (x (x b)) <: Prims.int +type box2 (a: Type) = | Box2 : x: a -> Bug3227.box2 a + + + +let test b = Box2? b && Box2? b.x +] +Exports: [ +type box (a: Type) = { } + +let proj b = x (x (x b)) <: Prims.int +type box2 (a: Type) = | Box2 : x: a -> Bug3227.box2 a + + + +let test b = Box2? b && Box2? b.x +] + +Module before type checking: +module Bug3227 +Declarations: [ +type box (a: Type) = { } + +let proj b = x (x (x b)) <: Prims.int +type box2 (a: Type) = | Box2 : x: a -> Bug3227.box2 a + + + +let test b = Box2? b && Box2? b.x +] +Exports: [ +type box (a: Type) = { } + +let proj b = x (x (x b)) <: Prims.int +type box2 (a: Type) = | Box2 : x: a -> Bug3227.box2 a + + + +let test b = Box2? b && Box2? b.x +] + +Module after type checking: +module Bug3227 +Declarations: [ +type box (a: Type) = { x:a } +val box__uu___haseq: forall (a: Type). {:pattern Prims.hasEq (Bug3227.box a)} + Prims.l_True /\ Prims.hasEq a ==> Prims.hasEq (Bug3227.box a) + + +let proj b = b.x.x.x <: Prims.int +type box2 (a: Type) = | Box2 : x: a -> Bug3227.box2 a +val box2__uu___haseq: forall (a: Type). {:pattern Prims.hasEq (Bug3227.box2 a)} + Prims.l_True /\ Prims.hasEq a ==> Prims.hasEq (Bug3227.box2 a) + + + + +let test b = Box2? b && Box2? b.x +] +Exports: [ +type box (a: Type) = { x:a } +val box__uu___haseq: forall (a: Type). {:pattern Prims.hasEq (Bug3227.box a)} + Prims.l_True /\ Prims.hasEq a ==> Prims.hasEq (Bug3227.box a) + + +let proj b = b.x.x.x <: Prims.int +type box2 (a: Type) = | Box2 : x: a -> Bug3227.box2 a +val box2__uu___haseq: forall (a: Type). {:pattern Prims.hasEq (Bug3227.box2 a)} + Prims.l_True /\ Prims.hasEq a ==> Prims.hasEq (Bug3227.box2 a) + + + + +let test b = Box2? b && Box2? b.x +] + +Verified module: Bug3227 +All verification conditions discharged successfully diff --git a/tests/error-messages/Makefile b/tests/error-messages/Makefile index 81db0989c74..69d141cfced 100644 --- a/tests/error-messages/Makefile +++ b/tests/error-messages/Makefile @@ -21,8 +21,11 @@ OTHERFLAGS := $(filter-out --hint_info, $(OTHERFLAGS)) check-all: $(addsuffix .check, $(FSTAR_FILES)) all: check-all +# For these tests, we check that the resugared output +# matches the expected file. Bug1997.fst.output: OTHERFLAGS+=--dump_module Bug1997 Bug2820.fst.output: OTHERFLAGS+=--dump_module Bug2820 +Bug3227.fst.output: OTHERFLAGS+=--dump_module Bug3227 CalcImpl.fst.output: OTHERFLAGS+=--dump_module CalcImpl include $(FSTAR_HOME)/examples/Makefile.common From ba897e6f22b5954d6da60aa68a6f736a532165f7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 2 May 2024 16:00:40 -0700 Subject: [PATCH 164/239] snap --- ocaml/fstar-lib/generated/FStar_Options.ml | 2 +- .../fstar-lib/generated/FStar_Parser_Const.ml | 2 + .../generated/FStar_Syntax_Resugar.ml | 796 ++++++++++-------- .../generated/FStar_TypeChecker_Err.ml | 76 +- .../generated/FStar_TypeChecker_Normalize.ml | 35 +- .../generated/FStar_TypeChecker_Primops.ml | 703 +--------------- .../FStar_TypeChecker_Primops_Array.ml | 354 ++++++++ .../FStar_TypeChecker_Primops_Issue.ml | 108 +++ .../FStar_TypeChecker_Primops_Range.ml | 35 + .../FStar_TypeChecker_Primops_Sealed.ml | 198 +++++ .../generated/FStar_TypeChecker_Util.ml | 4 +- 11 files changed, 1233 insertions(+), 1080 deletions(-) create mode 100644 ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Array.ml create mode 100644 ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Issue.ml create mode 100644 ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Range.ml create mode 100644 ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Sealed.ml diff --git a/ocaml/fstar-lib/generated/FStar_Options.ml b/ocaml/fstar-lib/generated/FStar_Options.ml index c97932df033..f5e3154c97f 100644 --- a/ocaml/fstar-lib/generated/FStar_Options.ml +++ b/ocaml/fstar-lib/generated/FStar_Options.ml @@ -4169,7 +4169,7 @@ let (use_nbe_for_extraction : unit -> Prims.bool) = let (trivial_pre_for_unannotated_effectful_fns : unit -> Prims.bool) = fun uu___ -> get_trivial_pre_for_unannotated_effectful_fns () let (debug_keys : unit -> Prims.string Prims.list) = - fun uu___ -> lookup_opt "debug" (as_list as_string) + fun uu___ -> lookup_opt "debug" as_comma_string_list let (debug_all_modules : unit -> Prims.bool) = fun uu___ -> lookup_opt "debug_all_modules" as_bool let with_saved_options : 'a . (unit -> 'a) -> 'a = diff --git a/ocaml/fstar-lib/generated/FStar_Parser_Const.ml b/ocaml/fstar-lib/generated/FStar_Parser_Const.ml index a93eaf16fd5..29acbdceb05 100644 --- a/ocaml/fstar-lib/generated/FStar_Parser_Const.ml +++ b/ocaml/fstar-lib/generated/FStar_Parser_Const.ml @@ -259,6 +259,8 @@ let (__range_lid : FStar_Ident.lident) = p2l ["FStar"; "Range"; "__range"] let (range_lid : FStar_Ident.lident) = p2l ["FStar"; "Range"; "range"] let (range_0 : FStar_Ident.lident) = p2l ["FStar"; "Range"; "range_0"] let (mk_range_lid : FStar_Ident.lident) = p2l ["FStar"; "Range"; "mk_range"] +let (join_range_lid : FStar_Ident.lident) = + p2l ["FStar"; "Range"; "join_range"] let (guard_free : FStar_Ident.lident) = pconst "guard_free" let (inversion_lid : FStar_Ident.lident) = p2l ["FStar"; "Pervasives"; "inversion"] diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml index e09b08ea5a0..3931c66662e 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml @@ -810,376 +810,452 @@ let rec (resugar_term' : let args1 = let uu___1 = FStar_Options.print_implicits () in if uu___1 then args else filter_imp_args args in - let uu___1 = resugar_term_as_op e in - (match uu___1 with - | FStar_Pervasives_Native.None -> resugar_as_app e args1 - | FStar_Pervasives_Native.Some ("calc_finish", uu___2) -> - let uu___3 = resugar_calc env t in - (match uu___3 with - | FStar_Pervasives_Native.Some r -> r - | uu___4 -> resugar_as_app e args1) - | FStar_Pervasives_Native.Some ("tuple", uu___2) -> - let out = - FStar_Compiler_List.fold_left - (fun out1 -> - fun uu___3 -> - match uu___3 with - | (x, uu___4) -> - let x1 = resugar_term' env x in - (match out1 with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.Some x1 - | FStar_Pervasives_Native.Some prefix -> - let uu___5 = - let uu___6 = - let uu___7 = - let uu___8 = - FStar_Ident.id_of_text "*" in - (uu___8, [prefix; x1]) in - FStar_Parser_AST.Op uu___7 in - mk uu___6 in - FStar_Pervasives_Native.Some uu___5)) - FStar_Pervasives_Native.None args1 in - FStar_Compiler_Option.get out - | FStar_Pervasives_Native.Some ("dtuple", uu___2) -> - resugar_as_app e args1 - | FStar_Pervasives_Native.Some (ref_read, uu___2) when - let uu___3 = - FStar_Ident.string_of_lid FStar_Parser_Const.sread_lid in - ref_read = uu___3 -> - let uu___3 = FStar_Compiler_List.hd args1 in - (match uu___3 with - | (t1, uu___4) -> - let uu___5 = - let uu___6 = FStar_Syntax_Subst.compress t1 in - uu___6.FStar_Syntax_Syntax.n in - (match uu___5 with - | FStar_Syntax_Syntax.Tm_fvar fv when - let uu___6 = - FStar_Ident.string_of_lid - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - FStar_Syntax_Util.field_projector_contains_constructor - uu___6 - -> - let f = + let is_projector t1 = + let uu___1 = + let uu___2 = + let uu___3 = FStar_Syntax_Subst.compress t1 in + FStar_Syntax_Util.un_uinst uu___3 in + uu___2.FStar_Syntax_Syntax.n in + match uu___1 with + | FStar_Syntax_Syntax.Tm_fvar fv -> + let a = + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + let length = + let uu___2 = + FStar_Ident.nsstr + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + FStar_Compiler_String.length uu___2 in + let s = + if length = Prims.int_zero + then FStar_Ident.string_of_lid a + else + (let uu___3 = FStar_Ident.string_of_lid a in + FStar_Compiler_Util.substring_from uu___3 + (length + Prims.int_one)) in + if + FStar_Compiler_Util.starts_with s + FStar_Syntax_Util.field_projector_prefix + then + let rest = + FStar_Compiler_Util.substring_from s + (FStar_Compiler_String.length + FStar_Syntax_Util.field_projector_prefix) in + let r = + FStar_Compiler_Util.split rest + FStar_Syntax_Util.field_projector_sep in + (match r with + | fst::snd::[] -> + let l = + FStar_Ident.lid_of_path [fst] + t1.FStar_Syntax_Syntax.pos in + let r1 = + FStar_Ident.mk_ident + (snd, (t1.FStar_Syntax_Syntax.pos)) in + FStar_Pervasives_Native.Some (l, r1) + | uu___2 -> + FStar_Compiler_Effect.failwith + "wrong projector format") + else FStar_Pervasives_Native.None + | uu___2 -> FStar_Pervasives_Native.None in + let uu___1 = + (let uu___2 = is_projector e in + FStar_Pervasives_Native.uu___is_Some uu___2) && + ((FStar_Compiler_List.length args1) = Prims.int_one) in + if uu___1 + then + let uu___2 = + let uu___3 = is_projector e in + FStar_Pervasives_Native.__proj__Some__item__v uu___3 in + (match uu___2 with + | (uu___3, fi) -> + let arg = + let uu___4 = + let uu___5 = FStar_Compiler_List.hd args1 in + FStar_Pervasives_Native.fst uu___5 in + resugar_term' env uu___4 in + let uu___4 = + let uu___5 = + let uu___6 = FStar_Ident.lid_of_ids [fi] in + (arg, uu___6) in + FStar_Parser_AST.Project uu___5 in + mk uu___4) + else + (let uu___3 = resugar_term_as_op e in + match uu___3 with + | FStar_Pervasives_Native.None -> resugar_as_app e args1 + | FStar_Pervasives_Native.Some ("calc_finish", uu___4) -> + let uu___5 = resugar_calc env t in + (match uu___5 with + | FStar_Pervasives_Native.Some r -> r + | uu___6 -> resugar_as_app e args1) + | FStar_Pervasives_Native.Some ("tuple", uu___4) -> + let out = + FStar_Compiler_List.fold_left + (fun out1 -> + fun uu___5 -> + match uu___5 with + | (x, uu___6) -> + let x1 = resugar_term' env x in + (match out1 with + | FStar_Pervasives_Native.None -> + FStar_Pervasives_Native.Some x1 + | FStar_Pervasives_Native.Some prefix -> + let uu___7 = + let uu___8 = + let uu___9 = + let uu___10 = + FStar_Ident.id_of_text "*" in + (uu___10, [prefix; x1]) in + FStar_Parser_AST.Op uu___9 in + mk uu___8 in + FStar_Pervasives_Native.Some uu___7)) + FStar_Pervasives_Native.None args1 in + FStar_Compiler_Option.get out + | FStar_Pervasives_Native.Some ("dtuple", uu___4) -> + resugar_as_app e args1 + | FStar_Pervasives_Native.Some (ref_read, uu___4) when + let uu___5 = + FStar_Ident.string_of_lid FStar_Parser_Const.sread_lid in + ref_read = uu___5 -> + let uu___5 = FStar_Compiler_List.hd args1 in + (match uu___5 with + | (t1, uu___6) -> + let uu___7 = + let uu___8 = FStar_Syntax_Subst.compress t1 in + uu___8.FStar_Syntax_Syntax.n in + (match uu___7 with + | FStar_Syntax_Syntax.Tm_fvar fv when + let uu___8 = + FStar_Ident.string_of_lid + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + FStar_Syntax_Util.field_projector_contains_constructor + uu___8 + -> + let f = + let uu___8 = + let uu___9 = + FStar_Ident.string_of_lid + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + [uu___9] in + FStar_Ident.lid_of_path uu___8 + t1.FStar_Syntax_Syntax.pos in + let uu___8 = + let uu___9 = + let uu___10 = resugar_term' env t1 in + (uu___10, f) in + FStar_Parser_AST.Project uu___9 in + mk uu___8 + | uu___8 -> resugar_term' env t1)) + | FStar_Pervasives_Native.Some ("try_with", uu___4) when + (FStar_Compiler_List.length args1) > Prims.int_one -> + (try + (fun uu___5 -> + match () with + | () -> + let new_args = first_two_explicit args1 in let uu___6 = - let uu___7 = - FStar_Ident.string_of_lid - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - [uu___7] in - FStar_Ident.lid_of_path uu___6 - t1.FStar_Syntax_Syntax.pos in - let uu___6 = - let uu___7 = - let uu___8 = resugar_term' env t1 in (uu___8, f) in - FStar_Parser_AST.Project uu___7 in - mk uu___6 - | uu___6 -> resugar_term' env t1)) - | FStar_Pervasives_Native.Some ("try_with", uu___2) when - (FStar_Compiler_List.length args1) > Prims.int_one -> - (try - (fun uu___3 -> - match () with - | () -> - let new_args = first_two_explicit args1 in - let uu___4 = - match new_args with - | (a1, uu___5)::(a2, uu___6)::[] -> (a1, a2) - | uu___5 -> - FStar_Compiler_Effect.failwith - "wrong arguments to try_with" in - (match uu___4 with - | (body, handler) -> - let decomp term = - let uu___5 = - let uu___6 = - FStar_Syntax_Subst.compress term in - uu___6.FStar_Syntax_Syntax.n in - match uu___5 with - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = x; - FStar_Syntax_Syntax.body = e1; - FStar_Syntax_Syntax.rc_opt = uu___6;_} - -> - let uu___7 = - FStar_Syntax_Subst.open_term x e1 in - (match uu___7 with | (x1, e2) -> e2) - | uu___6 -> - let uu___7 = - let uu___8 = - let uu___9 = resugar_term' env term in - FStar_Parser_AST.term_to_string - uu___9 in - Prims.strcat - "wrong argument format to try_with: " - uu___8 in - FStar_Compiler_Effect.failwith uu___7 in - let body1 = - let uu___5 = decomp body in - resugar_term' env uu___5 in - let handler1 = - let uu___5 = decomp handler in - resugar_term' env uu___5 in - let rec resugar_body t1 = - match t1.FStar_Parser_AST.tm with - | FStar_Parser_AST.Match - (e1, FStar_Pervasives_Native.None, - FStar_Pervasives_Native.None, - (uu___5, uu___6, b)::[]) - -> b - | FStar_Parser_AST.Let (uu___5, uu___6, b) -> - b - | FStar_Parser_AST.Ascribed - (t11, t2, t3, use_eq) -> - let uu___5 = - let uu___6 = - let uu___7 = resugar_body t11 in - (uu___7, t2, t3, use_eq) in - FStar_Parser_AST.Ascribed uu___6 in - mk uu___5 - | uu___5 -> - FStar_Compiler_Effect.failwith - "unexpected body format to try_with" in - let e1 = resugar_body body1 in - let rec resugar_branches t1 = - match t1.FStar_Parser_AST.tm with - | FStar_Parser_AST.Match - (e2, FStar_Pervasives_Native.None, - FStar_Pervasives_Native.None, branches) - -> branches - | FStar_Parser_AST.Ascribed - (t11, t2, t3, uu___5) -> - resugar_branches t11 - | uu___5 -> [] in - let branches = resugar_branches handler1 in - mk (FStar_Parser_AST.TryWith (e1, branches)))) - () - with | uu___3 -> resugar_as_app e args1) - | FStar_Pervasives_Native.Some ("try_with", uu___2) -> - resugar_as_app e args1 - | FStar_Pervasives_Native.Some (op, uu___2) when - (((((((op = "=") || (op = "==")) || (op = "===")) || - (op = "@")) - || (op = ":=")) - || (op = "|>")) - || (op = "<<")) - && (FStar_Options.print_implicits ()) - -> resugar_as_app e args1 - | FStar_Pervasives_Native.Some (op, uu___2) when - (FStar_Compiler_Util.starts_with op "forall") || - (FStar_Compiler_Util.starts_with op "exists") - -> - let rec uncurry xs pats t1 flavor_matches = - match t1.FStar_Parser_AST.tm with - | FStar_Parser_AST.QExists (xs', (uu___3, pats'), body) when - flavor_matches t1 -> - uncurry (FStar_Compiler_List.op_At xs xs') - (FStar_Compiler_List.op_At pats pats') body - flavor_matches - | FStar_Parser_AST.QForall (xs', (uu___3, pats'), body) when - flavor_matches t1 -> - uncurry (FStar_Compiler_List.op_At xs xs') - (FStar_Compiler_List.op_At pats pats') body - flavor_matches - | FStar_Parser_AST.QuantOp - (uu___3, xs', (uu___4, pats'), body) when - flavor_matches t1 -> - uncurry (FStar_Compiler_List.op_At xs xs') - (FStar_Compiler_List.op_At pats pats') body - flavor_matches - | uu___3 -> (xs, pats, t1) in - let resugar_forall_body body = - let uu___3 = - let uu___4 = FStar_Syntax_Subst.compress body in - uu___4.FStar_Syntax_Syntax.n in - match uu___3 with - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = xs; - FStar_Syntax_Syntax.body = body1; - FStar_Syntax_Syntax.rc_opt = uu___4;_} - -> - let uu___5 = FStar_Syntax_Subst.open_term xs body1 in - (match uu___5 with - | (xs1, body2) -> - let xs2 = - let uu___6 = FStar_Options.print_implicits () in - if uu___6 then xs1 else filter_imp_bs xs1 in - let xs3 = - (map_opt ()) - (fun b -> - resugar_binder' env b - t.FStar_Syntax_Syntax.pos) xs2 in - let uu___6 = - let uu___7 = - let uu___8 = FStar_Syntax_Subst.compress body2 in - uu___8.FStar_Syntax_Syntax.n in - match uu___7 with - | FStar_Syntax_Syntax.Tm_meta - { FStar_Syntax_Syntax.tm2 = e1; - FStar_Syntax_Syntax.meta = m;_} - -> - let body3 = resugar_term' env e1 in - let uu___8 = - match m with - | FStar_Syntax_Syntax.Meta_pattern - (uu___9, pats) -> - let uu___10 = - FStar_Compiler_List.map - (fun es -> - FStar_Compiler_List.map - (fun uu___11 -> - match uu___11 with - | (e2, uu___12) -> - resugar_term' env e2) - es) pats in - (uu___10, body3) - | FStar_Syntax_Syntax.Meta_labeled - (s, r, p) -> + match new_args with + | (a1, uu___7)::(a2, uu___8)::[] -> (a1, a2) + | uu___7 -> + FStar_Compiler_Effect.failwith + "wrong arguments to try_with" in + (match uu___6 with + | (body, handler) -> + let decomp term = + let uu___7 = + let uu___8 = + FStar_Syntax_Subst.compress term in + uu___8.FStar_Syntax_Syntax.n in + match uu___7 with + | FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = x; + FStar_Syntax_Syntax.body = e1; + FStar_Syntax_Syntax.rc_opt = uu___8;_} + -> + let uu___9 = + FStar_Syntax_Subst.open_term x e1 in + (match uu___9 with | (x1, e2) -> e2) + | uu___8 -> let uu___9 = let uu___10 = let uu___11 = - let uu___12 = - FStar_Errors_Msg.rendermsg s in - (body3, uu___12, p) in - FStar_Parser_AST.Labeled uu___11 in - mk uu___10 in - ([], uu___9) - | uu___9 -> + resugar_term' env term in + FStar_Parser_AST.term_to_string + uu___11 in + Prims.strcat + "wrong argument format to try_with: " + uu___10 in + FStar_Compiler_Effect.failwith uu___9 in + let body1 = + let uu___7 = decomp body in + resugar_term' env uu___7 in + let handler1 = + let uu___7 = decomp handler in + resugar_term' env uu___7 in + let rec resugar_body t1 = + match t1.FStar_Parser_AST.tm with + | FStar_Parser_AST.Match + (e1, FStar_Pervasives_Native.None, + FStar_Pervasives_Native.None, + (uu___7, uu___8, b)::[]) + -> b + | FStar_Parser_AST.Let (uu___7, uu___8, b) + -> b + | FStar_Parser_AST.Ascribed + (t11, t2, t3, use_eq) -> + let uu___7 = + let uu___8 = + let uu___9 = resugar_body t11 in + (uu___9, t2, t3, use_eq) in + FStar_Parser_AST.Ascribed uu___8 in + mk uu___7 + | uu___7 -> FStar_Compiler_Effect.failwith - "wrong pattern format for QForall/QExists" in - (match uu___8 with - | (pats, body4) -> (pats, body4)) - | uu___8 -> - let uu___9 = resugar_term' env body2 in - ([], uu___9) in - (match uu___6 with - | (pats, body3) -> - let decompile_op op1 = - let uu___7 = - FStar_Parser_AST.string_to_op op1 in - match uu___7 with - | FStar_Pervasives_Native.None -> op1 - | FStar_Pervasives_Native.Some (op2, uu___8) - -> op2 in - let flavor_matches t1 = - match ((t1.FStar_Parser_AST.tm), op) with - | (FStar_Parser_AST.QExists uu___7, - "exists") -> true - | (FStar_Parser_AST.QForall uu___7, - "forall") -> true - | (FStar_Parser_AST.QuantOp - (id, uu___7, uu___8, uu___9), uu___10) -> - let uu___11 = - FStar_Ident.string_of_id id in - uu___11 = op - | uu___7 -> false in - let uu___7 = - uncurry xs3 pats body3 flavor_matches in - (match uu___7 with - | (xs4, pats1, body4) -> - let binders = - FStar_Parser_AST.idents_of_binders xs4 - t.FStar_Syntax_Syntax.pos in - if op = "forall" - then - mk - (FStar_Parser_AST.QForall - (xs4, (binders, pats1), body4)) - else - if op = "exists" + "unexpected body format to try_with" in + let e1 = resugar_body body1 in + let rec resugar_branches t1 = + match t1.FStar_Parser_AST.tm with + | FStar_Parser_AST.Match + (e2, FStar_Pervasives_Native.None, + FStar_Pervasives_Native.None, + branches) + -> branches + | FStar_Parser_AST.Ascribed + (t11, t2, t3, uu___7) -> + resugar_branches t11 + | uu___7 -> [] in + let branches = resugar_branches handler1 in + mk (FStar_Parser_AST.TryWith (e1, branches)))) + () + with | uu___5 -> resugar_as_app e args1) + | FStar_Pervasives_Native.Some ("try_with", uu___4) -> + resugar_as_app e args1 + | FStar_Pervasives_Native.Some (op, uu___4) when + (((((((op = "=") || (op = "==")) || (op = "===")) || + (op = "@")) + || (op = ":=")) + || (op = "|>")) + || (op = "<<")) + && (FStar_Options.print_implicits ()) + -> resugar_as_app e args1 + | FStar_Pervasives_Native.Some (op, uu___4) when + (FStar_Compiler_Util.starts_with op "forall") || + (FStar_Compiler_Util.starts_with op "exists") + -> + let rec uncurry xs pats t1 flavor_matches = + match t1.FStar_Parser_AST.tm with + | FStar_Parser_AST.QExists (xs', (uu___5, pats'), body) + when flavor_matches t1 -> + uncurry (FStar_Compiler_List.op_At xs xs') + (FStar_Compiler_List.op_At pats pats') body + flavor_matches + | FStar_Parser_AST.QForall (xs', (uu___5, pats'), body) + when flavor_matches t1 -> + uncurry (FStar_Compiler_List.op_At xs xs') + (FStar_Compiler_List.op_At pats pats') body + flavor_matches + | FStar_Parser_AST.QuantOp + (uu___5, xs', (uu___6, pats'), body) when + flavor_matches t1 -> + uncurry (FStar_Compiler_List.op_At xs xs') + (FStar_Compiler_List.op_At pats pats') body + flavor_matches + | uu___5 -> (xs, pats, t1) in + let resugar_forall_body body = + let uu___5 = + let uu___6 = FStar_Syntax_Subst.compress body in + uu___6.FStar_Syntax_Syntax.n in + match uu___5 with + | FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = xs; + FStar_Syntax_Syntax.body = body1; + FStar_Syntax_Syntax.rc_opt = uu___6;_} + -> + let uu___7 = FStar_Syntax_Subst.open_term xs body1 in + (match uu___7 with + | (xs1, body2) -> + let xs2 = + let uu___8 = FStar_Options.print_implicits () in + if uu___8 then xs1 else filter_imp_bs xs1 in + let xs3 = + (map_opt ()) + (fun b -> + resugar_binder' env b + t.FStar_Syntax_Syntax.pos) xs2 in + let uu___8 = + let uu___9 = + let uu___10 = + FStar_Syntax_Subst.compress body2 in + uu___10.FStar_Syntax_Syntax.n in + match uu___9 with + | FStar_Syntax_Syntax.Tm_meta + { FStar_Syntax_Syntax.tm2 = e1; + FStar_Syntax_Syntax.meta = m;_} + -> + let body3 = resugar_term' env e1 in + let uu___10 = + match m with + | FStar_Syntax_Syntax.Meta_pattern + (uu___11, pats) -> + let uu___12 = + FStar_Compiler_List.map + (fun es -> + FStar_Compiler_List.map + (fun uu___13 -> + match uu___13 with + | (e2, uu___14) -> + resugar_term' env e2) + es) pats in + (uu___12, body3) + | FStar_Syntax_Syntax.Meta_labeled + (s, r, p) -> + let uu___11 = + let uu___12 = + let uu___13 = + let uu___14 = + FStar_Errors_Msg.rendermsg s in + (body3, uu___14, p) in + FStar_Parser_AST.Labeled uu___13 in + mk uu___12 in + ([], uu___11) + | uu___11 -> + FStar_Compiler_Effect.failwith + "wrong pattern format for QForall/QExists" in + (match uu___10 with + | (pats, body4) -> (pats, body4)) + | uu___10 -> + let uu___11 = resugar_term' env body2 in + ([], uu___11) in + (match uu___8 with + | (pats, body3) -> + let decompile_op op1 = + let uu___9 = + FStar_Parser_AST.string_to_op op1 in + match uu___9 with + | FStar_Pervasives_Native.None -> op1 + | FStar_Pervasives_Native.Some + (op2, uu___10) -> op2 in + let flavor_matches t1 = + match ((t1.FStar_Parser_AST.tm), op) with + | (FStar_Parser_AST.QExists uu___9, + "exists") -> true + | (FStar_Parser_AST.QForall uu___9, + "forall") -> true + | (FStar_Parser_AST.QuantOp + (id, uu___9, uu___10, uu___11), + uu___12) -> + let uu___13 = + FStar_Ident.string_of_id id in + uu___13 = op + | uu___9 -> false in + let uu___9 = + uncurry xs3 pats body3 flavor_matches in + (match uu___9 with + | (xs4, pats1, body4) -> + let binders = + FStar_Parser_AST.idents_of_binders + xs4 t.FStar_Syntax_Syntax.pos in + if op = "forall" then mk - (FStar_Parser_AST.QExists + (FStar_Parser_AST.QForall (xs4, (binders, pats1), body4)) else - (let uu___10 = - let uu___11 = - let uu___12 = - FStar_Ident.id_of_text op in - (uu___12, xs4, (binders, pats1), - body4) in - FStar_Parser_AST.QuantOp uu___11 in - mk uu___10)))) - | uu___4 -> - if op = "forall" - then - let uu___5 = - let uu___6 = - let uu___7 = resugar_term' env body in - ([], ([], []), uu___7) in - FStar_Parser_AST.QForall uu___6 in - mk uu___5 - else - (let uu___6 = - let uu___7 = - let uu___8 = resugar_term' env body in - ([], ([], []), uu___8) in - FStar_Parser_AST.QExists uu___7 in - mk uu___6) in - if (FStar_Compiler_List.length args1) > Prims.int_zero - then - let args2 = last args1 in - (match args2 with - | (b, uu___3)::[] -> resugar_forall_body b - | uu___3 -> - FStar_Compiler_Effect.failwith - "wrong args format to QForall") - else resugar_as_app e args1 - | FStar_Pervasives_Native.Some ("alloc", uu___2) -> - let uu___3 = FStar_Compiler_List.hd args1 in - (match uu___3 with | (e1, uu___4) -> resugar_term' env e1) - | FStar_Pervasives_Native.Some (op, expected_arity1) -> - let op1 = FStar_Ident.id_of_text op in - let resugar args2 = - FStar_Compiler_List.map - (fun uu___2 -> - match uu___2 with - | (e1, qual) -> - let uu___3 = resugar_term' env e1 in - let uu___4 = resugar_aqual env qual in - (uu___3, uu___4)) args2 in - (match expected_arity1 with - | FStar_Pervasives_Native.None -> - let resugared_args = resugar args1 in - let expect_n = - FStar_Parser_ToDocument.handleable_args_length op1 in - if - (FStar_Compiler_List.length resugared_args) >= expect_n - then - let uu___2 = - FStar_Compiler_Util.first_N expect_n resugared_args in - (match uu___2 with - | (op_args, rest) -> - let head = - let uu___3 = - let uu___4 = - let uu___5 = - FStar_Compiler_List.map - FStar_Pervasives_Native.fst op_args in - (op1, uu___5) in - FStar_Parser_AST.Op uu___4 in - mk uu___3 in - FStar_Compiler_List.fold_left - (fun head1 -> - fun uu___3 -> - match uu___3 with - | (arg, qual) -> - mk - (FStar_Parser_AST.App - (head1, arg, qual))) head rest) - else resugar_as_app e args1 - | FStar_Pervasives_Native.Some n when - (FStar_Compiler_List.length args1) = n -> - let uu___2 = - let uu___3 = + if op = "exists" + then + mk + (FStar_Parser_AST.QExists + (xs4, (binders, pats1), body4)) + else + (let uu___12 = + let uu___13 = + let uu___14 = + FStar_Ident.id_of_text op in + (uu___14, xs4, + (binders, pats1), body4) in + FStar_Parser_AST.QuantOp uu___13 in + mk uu___12)))) + | uu___6 -> + if op = "forall" + then + let uu___7 = + let uu___8 = + let uu___9 = resugar_term' env body in + ([], ([], []), uu___9) in + FStar_Parser_AST.QForall uu___8 in + mk uu___7 + else + (let uu___8 = + let uu___9 = + let uu___10 = resugar_term' env body in + ([], ([], []), uu___10) in + FStar_Parser_AST.QExists uu___9 in + mk uu___8) in + if (FStar_Compiler_List.length args1) > Prims.int_zero + then + let args2 = last args1 in + (match args2 with + | (b, uu___5)::[] -> resugar_forall_body b + | uu___5 -> + FStar_Compiler_Effect.failwith + "wrong args format to QForall") + else resugar_as_app e args1 + | FStar_Pervasives_Native.Some ("alloc", uu___4) -> + let uu___5 = FStar_Compiler_List.hd args1 in + (match uu___5 with | (e1, uu___6) -> resugar_term' env e1) + | FStar_Pervasives_Native.Some (op, expected_arity1) -> + let op1 = FStar_Ident.id_of_text op in + let resugar args2 = + FStar_Compiler_List.map + (fun uu___4 -> + match uu___4 with + | (e1, qual) -> + let uu___5 = resugar_term' env e1 in + let uu___6 = resugar_aqual env qual in + (uu___5, uu___6)) args2 in + (match expected_arity1 with + | FStar_Pervasives_Native.None -> + let resugared_args = resugar args1 in + let expect_n = + FStar_Parser_ToDocument.handleable_args_length op1 in + if + (FStar_Compiler_List.length resugared_args) >= + expect_n + then let uu___4 = - let uu___5 = resugar args1 in - FStar_Compiler_List.map FStar_Pervasives_Native.fst - uu___5 in - (op1, uu___4) in - FStar_Parser_AST.Op uu___3 in - mk uu___2 - | uu___2 -> resugar_as_app e args1)) + FStar_Compiler_Util.first_N expect_n resugared_args in + (match uu___4 with + | (op_args, rest) -> + let head = + let uu___5 = + let uu___6 = + let uu___7 = + FStar_Compiler_List.map + FStar_Pervasives_Native.fst op_args in + (op1, uu___7) in + FStar_Parser_AST.Op uu___6 in + mk uu___5 in + FStar_Compiler_List.fold_left + (fun head1 -> + fun uu___5 -> + match uu___5 with + | (arg, qual) -> + mk + (FStar_Parser_AST.App + (head1, arg, qual))) head rest) + else resugar_as_app e args1 + | FStar_Pervasives_Native.Some n when + (FStar_Compiler_List.length args1) = n -> + let uu___4 = + let uu___5 = + let uu___6 = + let uu___7 = resugar args1 in + FStar_Compiler_List.map + FStar_Pervasives_Native.fst uu___7 in + (op1, uu___6) in + FStar_Parser_AST.Op uu___5 in + mk uu___4 + | uu___4 -> resugar_as_app e args1)) | FStar_Syntax_Syntax.Tm_match { FStar_Syntax_Syntax.scrutinee = e; FStar_Syntax_Syntax.ret_opt = FStar_Pervasives_Native.None; diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml index 6a5a1fa6a26..8ad26c31e13 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml @@ -475,48 +475,84 @@ let computed_computation_type_does_not_match_annotation : 'uuuuu -> FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> - (FStar_Errors_Codes.raw_error * Prims.string) + (FStar_Errors_Codes.raw_error * FStar_Pprint.document Prims.list) = fun env -> fun e -> fun c -> fun c' -> + let ppt = FStar_TypeChecker_Normalize.term_to_doc env in let uu___ = name_and_result c in match uu___ with | (f1, r1) -> let uu___1 = name_and_result c' in (match uu___1 with | (f2, r2) -> - let uu___2 = err_msg_type_strings env r1 r2 in - (match uu___2 with - | (s1, s2) -> - let uu___3 = - FStar_Compiler_Util.format4 - "Computed type \"%s\" and effect \"%s\" is not compatible with the annotated type \"%s\" effect \"%s\"" - s1 f1 s2 f2 in - (FStar_Errors_Codes.Fatal_ComputedTypeNotMatchAnnotation, - uu___3))) + let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = FStar_Errors_Msg.text "Computed type" in + let uu___6 = ppt r1 in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one + uu___5 uu___6 in + let uu___5 = + let uu___6 = + let uu___7 = FStar_Errors_Msg.text "and effect" in + let uu___8 = FStar_Errors_Msg.text f1 in + FStar_Pprint.prefix (Prims.of_int (2)) + Prims.int_one uu___7 uu___8 in + let uu___7 = + let uu___8 = + let uu___9 = + FStar_Errors_Msg.text + "is not compatible with the annotated type" in + let uu___10 = ppt r2 in + FStar_Pprint.prefix (Prims.of_int (2)) + Prims.int_one uu___9 uu___10 in + let uu___9 = + let uu___10 = FStar_Errors_Msg.text "and effect" in + let uu___11 = FStar_Errors_Msg.text f2 in + FStar_Pprint.prefix (Prims.of_int (2)) + Prims.int_one uu___10 uu___11 in + FStar_Pprint.op_Hat_Slash_Hat uu___8 uu___9 in + FStar_Pprint.op_Hat_Slash_Hat uu___6 uu___7 in + FStar_Pprint.op_Hat_Slash_Hat uu___4 uu___5 in + [uu___3] in + (FStar_Errors_Codes.Fatal_ComputedTypeNotMatchAnnotation, + uu___2)) let computed_computation_type_does_not_match_annotation_eq : 'uuuuu . FStar_TypeChecker_Env.env -> 'uuuuu -> FStar_Syntax_Syntax.comp -> FStar_Syntax_Syntax.comp -> - (FStar_Errors_Codes.raw_error * Prims.string) + (FStar_Errors_Codes.raw_error * FStar_Pprint.document Prims.list) = fun env -> fun e -> fun c -> fun c' -> - let uu___ = err_msg_comp_strings env c c' in - match uu___ with - | (s1, s2) -> - let uu___1 = - FStar_Compiler_Util.format2 - "Computed type \"%s\" does not match annotated type \"%s\", and no subtyping was allowed" - s1 s2 in - (FStar_Errors_Codes.Fatal_ComputedTypeNotMatchAnnotation, - uu___1) + let ppc = FStar_TypeChecker_Normalize.comp_to_doc env in + let uu___ = + let uu___1 = + let uu___2 = + let uu___3 = FStar_Errors_Msg.text "Computed type" in + let uu___4 = ppc c in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one uu___3 + uu___4 in + let uu___3 = + let uu___4 = + let uu___5 = + FStar_Errors_Msg.text "does not match annotated type" in + let uu___6 = ppc c' in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one uu___5 + uu___6 in + let uu___5 = + FStar_Errors_Msg.text "and no subtyping was allowed" in + FStar_Pprint.op_Hat_Slash_Hat uu___4 uu___5 in + FStar_Pprint.op_Hat_Slash_Hat uu___2 uu___3 in + [uu___1] in + (FStar_Errors_Codes.Fatal_ComputedTypeNotMatchAnnotation, uu___) let (unexpected_non_trivial_precondition_on_term : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> (FStar_Errors_Codes.raw_error * Prims.string)) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml index 8ea83978024..2a513661f11 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml @@ -8508,6 +8508,39 @@ let (comp_to_string : env1.FStar_TypeChecker_Env.dsenv env1.FStar_TypeChecker_Env.curmodule in FStar_Syntax_Print.comp_to_string' uu___1 c1) +let (comp_to_doc : + FStar_TypeChecker_Env.env -> + FStar_Syntax_Syntax.comp -> FStar_Pprint.document) + = + fun env1 -> + fun c -> + FStar_GenSym.with_frozen_gensym + (fun uu___ -> + let c1 = + try + (fun uu___1 -> + match () with + | () -> + let uu___2 = + FStar_TypeChecker_Cfg.config + [FStar_TypeChecker_Env.AllowUnboundUniverses] env1 in + norm_comp uu___2 [] c) () + with + | uu___1 -> + ((let uu___3 = + let uu___4 = + let uu___5 = FStar_Compiler_Util.message_of_exn uu___1 in + FStar_Compiler_Util.format1 + "Normalization failed with error %s\n" uu___5 in + (FStar_Errors_Codes.Warning_NormalizationFailure, + uu___4) in + FStar_Errors.log_issue c.FStar_Syntax_Syntax.pos uu___3); + c) in + let uu___1 = + FStar_Syntax_DsEnv.set_current_module + env1.FStar_TypeChecker_Env.dsenv + env1.FStar_TypeChecker_Env.curmodule in + FStar_Syntax_Print.comp_to_doc' uu___1 c1) let (normalize_refinement : FStar_TypeChecker_Env.steps -> FStar_TypeChecker_Env.env -> @@ -9642,7 +9675,7 @@ let (get_n_binders : FStar_Syntax_Syntax.term -> (FStar_Syntax_Syntax.binder Prims.list * FStar_Syntax_Syntax.comp)) = fun env1 -> fun n -> fun t -> get_n_binders' env1 [] n t -let (uu___3793 : unit) = +let (uu___3806 : unit) = FStar_Compiler_Effect.op_Colon_Equals __get_n_binders get_n_binders' let (maybe_unfold_head_fv : FStar_TypeChecker_Env.env -> diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops.ml index 6bc474617d9..24b4d5315cb 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops.ml @@ -1,18 +1,4 @@ open Prims -let (arg_as_int : - FStar_Syntax_Syntax.arg -> FStar_BigInt.t FStar_Pervasives_Native.option) = - fun a -> - FStar_TypeChecker_Primops_Base.try_unembed_simple - FStar_Syntax_Embeddings.e_int (FStar_Pervasives_Native.fst a) -let arg_as_list : - 'a . - 'a FStar_Syntax_Embeddings_Base.embedding -> - FStar_Syntax_Syntax.arg -> 'a Prims.list FStar_Pervasives_Native.option - = - fun e -> - fun a1 -> - FStar_TypeChecker_Primops_Base.try_unembed_simple - (FStar_Syntax_Embeddings.e_list e) (FStar_Pervasives_Native.fst a1) let (as_primitive_step : Prims.bool -> (FStar_Ident.lident * Prims.int * Prims.int * @@ -29,100 +15,6 @@ let (as_primitive_step : FStar_TypeChecker_Primops_Base.as_primitive_step_nbecbs is_strong (l, arity, u_arity, f, (fun cb -> fun univs -> fun args -> f_nbe univs args)) -let mixed_binary_op : - 'a 'b 'c . - (FStar_Syntax_Syntax.arg -> 'a FStar_Pervasives_Native.option) -> - (FStar_Syntax_Syntax.arg -> 'b FStar_Pervasives_Native.option) -> - (FStar_Compiler_Range_Type.range -> 'c -> FStar_Syntax_Syntax.term) - -> - (FStar_Compiler_Range_Type.range -> - FStar_Syntax_Syntax.universes -> - 'a -> 'b -> 'c FStar_Pervasives_Native.option) - -> - FStar_TypeChecker_Primops_Base.psc -> - FStar_Syntax_Embeddings_Base.norm_cb -> - FStar_Syntax_Syntax.universes -> - FStar_Syntax_Syntax.args -> - FStar_Syntax_Syntax.term FStar_Pervasives_Native.option - = - fun as_a -> - fun as_b -> - fun embed_c -> - fun f -> - fun psc -> - fun norm_cb -> - fun univs -> - fun args -> - match args with - | a1::b1::[] -> - let uu___ = - let uu___1 = as_a a1 in - let uu___2 = as_b b1 in (uu___1, uu___2) in - (match uu___ with - | (FStar_Pervasives_Native.Some a2, - FStar_Pervasives_Native.Some b2) -> - let uu___1 = - f psc.FStar_TypeChecker_Primops_Base.psc_range - univs a2 b2 in - (match uu___1 with - | FStar_Pervasives_Native.Some c1 -> - let uu___2 = - embed_c - psc.FStar_TypeChecker_Primops_Base.psc_range - c1 in - FStar_Pervasives_Native.Some uu___2 - | uu___2 -> FStar_Pervasives_Native.None) - | uu___1 -> FStar_Pervasives_Native.None) - | uu___ -> FStar_Pervasives_Native.None -let mixed_ternary_op : - 'a 'b 'c 'd . - (FStar_Syntax_Syntax.arg -> 'a FStar_Pervasives_Native.option) -> - (FStar_Syntax_Syntax.arg -> 'b FStar_Pervasives_Native.option) -> - (FStar_Syntax_Syntax.arg -> 'c FStar_Pervasives_Native.option) -> - (FStar_Compiler_Range_Type.range -> 'd -> FStar_Syntax_Syntax.term) - -> - (FStar_Compiler_Range_Type.range -> - FStar_Syntax_Syntax.universes -> - 'a -> 'b -> 'c -> 'd FStar_Pervasives_Native.option) - -> - FStar_TypeChecker_Primops_Base.psc -> - FStar_Syntax_Embeddings_Base.norm_cb -> - FStar_Syntax_Syntax.universes -> - FStar_Syntax_Syntax.args -> - FStar_Syntax_Syntax.term FStar_Pervasives_Native.option - = - fun as_a -> - fun as_b -> - fun as_c -> - fun embed_d -> - fun f -> - fun psc -> - fun norm_cb -> - fun univs -> - fun args -> - match args with - | a1::b1::c1::[] -> - let uu___ = - let uu___1 = as_a a1 in - let uu___2 = as_b b1 in - let uu___3 = as_c c1 in (uu___1, uu___2, uu___3) in - (match uu___ with - | (FStar_Pervasives_Native.Some a2, - FStar_Pervasives_Native.Some b2, - FStar_Pervasives_Native.Some c2) -> - let uu___1 = - f psc.FStar_TypeChecker_Primops_Base.psc_range - univs a2 b2 c2 in - (match uu___1 with - | FStar_Pervasives_Native.Some d1 -> - let uu___2 = - embed_d - psc.FStar_TypeChecker_Primops_Base.psc_range - d1 in - FStar_Pervasives_Native.Some uu___2 - | uu___2 -> FStar_Pervasives_Native.None) - | uu___1 -> FStar_Pervasives_Native.None) - | uu___ -> FStar_Pervasives_Native.None let (and_op : FStar_TypeChecker_Primops_Base.psc -> FStar_Syntax_Embeddings_Base.norm_cb -> @@ -516,63 +408,7 @@ let (simple_ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Compiler_String.substring s uu___53 uu___54) in - let uu___53 = - let uu___54 = - FStar_TypeChecker_Primops_Base.mk5 - Prims.int_zero - FStar_Parser_Const.mk_range_lid - FStar_Syntax_Embeddings.e_string - FStar_TypeChecker_NBETerm.e_string - FStar_Syntax_Embeddings.e_int - FStar_TypeChecker_NBETerm.e_int - FStar_Syntax_Embeddings.e_int - FStar_TypeChecker_NBETerm.e_int - FStar_Syntax_Embeddings.e_int - FStar_TypeChecker_NBETerm.e_int - FStar_Syntax_Embeddings.e_int - FStar_TypeChecker_NBETerm.e_int - FStar_Syntax_Embeddings.e_range - FStar_TypeChecker_NBETerm.e_range - (fun fn -> - fun from_l -> - fun from_c - -> - fun to_l - -> - fun to_c - -> - let uu___55 - = - let uu___56 - = - FStar_BigInt.to_int_fs - from_l in - let uu___57 - = - FStar_BigInt.to_int_fs - from_c in - FStar_Compiler_Range_Type.mk_pos - uu___56 - uu___57 in - let uu___56 - = - let uu___57 - = - FStar_BigInt.to_int_fs - to_l in - let uu___58 - = - FStar_BigInt.to_int_fs - to_c in - FStar_Compiler_Range_Type.mk_pos - uu___57 - uu___58 in - FStar_Compiler_Range_Type.mk_range - fn - uu___55 - uu___56) in - [uu___54] in - uu___52 :: uu___53 in + [uu___52] in uu___50 :: uu___51 in uu___48 :: uu___49 in uu___46 :: uu___47 in @@ -599,533 +435,6 @@ let (simple_ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = uu___4 :: uu___5 in uu___2 :: uu___3 in uu___ :: uu___1 -let (bogus_cbs : FStar_TypeChecker_NBETerm.nbe_cbs) = - { - FStar_TypeChecker_NBETerm.iapp = (fun h -> fun _args -> h); - FStar_TypeChecker_NBETerm.translate = - (fun uu___ -> FStar_Compiler_Effect.failwith "bogus_cbs translate") - } -let (issue_ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = - let mk_lid l = FStar_Parser_Const.p2l ["FStar"; "Issue"; l] in - let uu___ = - let uu___1 = mk_lid "message_of_issue" in - FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___1 - FStar_Syntax_Embeddings.e_issue FStar_TypeChecker_NBETerm.e_issue - (FStar_Syntax_Embeddings.e_list FStar_Syntax_Embeddings.e_document) - (FStar_TypeChecker_NBETerm.e_list FStar_TypeChecker_NBETerm.e_document) - FStar_Errors.__proj__Mkissue__item__issue_msg in - let uu___1 = - let uu___2 = - let uu___3 = mk_lid "level_of_issue" in - FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___3 - FStar_Syntax_Embeddings.e_issue FStar_TypeChecker_NBETerm.e_issue - FStar_Syntax_Embeddings.e_string FStar_TypeChecker_NBETerm.e_string - (fun i -> - FStar_Errors.string_of_issue_level i.FStar_Errors.issue_level) in - let uu___3 = - let uu___4 = - let uu___5 = mk_lid "number_of_issue" in - FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___5 - FStar_Syntax_Embeddings.e_issue FStar_TypeChecker_NBETerm.e_issue - (FStar_Syntax_Embeddings.e_option FStar_Syntax_Embeddings.e_int) - (FStar_TypeChecker_NBETerm.e_option FStar_TypeChecker_NBETerm.e_int) - (fun uu___6 -> - (fun i -> - Obj.magic - (FStar_Class_Monad.fmap FStar_Class_Monad.monad_option () - () - (fun uu___6 -> (Obj.magic FStar_BigInt.of_int_fs) uu___6) - (Obj.magic i.FStar_Errors.issue_number))) uu___6) in - let uu___5 = - let uu___6 = - let uu___7 = mk_lid "range_of_issue" in - FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___7 - FStar_Syntax_Embeddings.e_issue FStar_TypeChecker_NBETerm.e_issue - (FStar_Syntax_Embeddings.e_option FStar_Syntax_Embeddings.e_range) - (FStar_TypeChecker_NBETerm.e_option - FStar_TypeChecker_NBETerm.e_range) - FStar_Errors.__proj__Mkissue__item__issue_range in - let uu___7 = - let uu___8 = - let uu___9 = mk_lid "context_of_issue" in - FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___9 - FStar_Syntax_Embeddings.e_issue - FStar_TypeChecker_NBETerm.e_issue - FStar_Syntax_Embeddings.e_string_list - FStar_TypeChecker_NBETerm.e_string_list - FStar_Errors.__proj__Mkissue__item__issue_ctx in - let uu___9 = - let uu___10 = - let uu___11 = mk_lid "render_issue" in - FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___11 - FStar_Syntax_Embeddings.e_issue - FStar_TypeChecker_NBETerm.e_issue - FStar_Syntax_Embeddings.e_string - FStar_TypeChecker_NBETerm.e_string FStar_Errors.format_issue in - let uu___11 = - let uu___12 = - let uu___13 = mk_lid "mk_issue_doc" in - FStar_TypeChecker_Primops_Base.mk5 Prims.int_zero uu___13 - FStar_Syntax_Embeddings.e_string - FStar_TypeChecker_NBETerm.e_string - (FStar_Syntax_Embeddings.e_list - FStar_Syntax_Embeddings.e_document) - (FStar_TypeChecker_NBETerm.e_list - FStar_TypeChecker_NBETerm.e_document) - (FStar_Syntax_Embeddings.e_option - FStar_Syntax_Embeddings.e_range) - (FStar_TypeChecker_NBETerm.e_option - FStar_TypeChecker_NBETerm.e_range) - (FStar_Syntax_Embeddings.e_option - FStar_Syntax_Embeddings.e_int) - (FStar_TypeChecker_NBETerm.e_option - FStar_TypeChecker_NBETerm.e_int) - FStar_Syntax_Embeddings.e_string_list - FStar_TypeChecker_NBETerm.e_string_list - FStar_Syntax_Embeddings.e_issue - FStar_TypeChecker_NBETerm.e_issue - (fun level -> - fun msg -> - fun range -> - fun number -> - fun context -> - let uu___14 = - FStar_Errors.issue_level_of_string level in - let uu___15 = - Obj.magic - (FStar_Class_Monad.fmap - FStar_Class_Monad.monad_option () () - (fun uu___16 -> - (Obj.magic FStar_BigInt.to_int_fs) - uu___16) (Obj.magic number)) in - { - FStar_Errors.issue_msg = msg; - FStar_Errors.issue_level = uu___14; - FStar_Errors.issue_range = range; - FStar_Errors.issue_number = uu___15; - FStar_Errors.issue_ctx = context - }) in - [uu___12] in - uu___10 :: uu___11 in - uu___8 :: uu___9 in - uu___6 :: uu___7 in - uu___4 :: uu___5 in - uu___2 :: uu___3 in - uu___ :: uu___1 -let (seal_steps : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = - FStar_Compiler_List.map - (fun p -> - let uu___ = - FStar_TypeChecker_Primops_Base.as_primitive_step_nbecbs true p in - { - FStar_TypeChecker_Primops_Base.name = - (uu___.FStar_TypeChecker_Primops_Base.name); - FStar_TypeChecker_Primops_Base.arity = - (uu___.FStar_TypeChecker_Primops_Base.arity); - FStar_TypeChecker_Primops_Base.univ_arity = - (uu___.FStar_TypeChecker_Primops_Base.univ_arity); - FStar_TypeChecker_Primops_Base.auto_reflect = - (uu___.FStar_TypeChecker_Primops_Base.auto_reflect); - FStar_TypeChecker_Primops_Base.strong_reduction_ok = - (uu___.FStar_TypeChecker_Primops_Base.strong_reduction_ok); - FStar_TypeChecker_Primops_Base.requires_binder_substitution = - (uu___.FStar_TypeChecker_Primops_Base.requires_binder_substitution); - FStar_TypeChecker_Primops_Base.renorm_after = true; - FStar_TypeChecker_Primops_Base.interpretation = - (uu___.FStar_TypeChecker_Primops_Base.interpretation); - FStar_TypeChecker_Primops_Base.interpretation_nbe = - (uu___.FStar_TypeChecker_Primops_Base.interpretation_nbe) - }) - [(FStar_Parser_Const.map_seal_lid, (Prims.of_int (4)), - (Prims.of_int (2)), - ((fun psc -> - fun univs -> - fun cbs -> - fun args -> - match args with - | (ta, uu___)::(tb, uu___1)::(s, uu___2)::(f, uu___3)::[] -> - let try_unembed e x = - FStar_Syntax_Embeddings_Base.try_unembed e x - FStar_Syntax_Embeddings_Base.id_norm_cb in - let uu___4 = - let uu___5 = - try_unembed FStar_Syntax_Embeddings.e_any ta in - let uu___6 = - try_unembed FStar_Syntax_Embeddings.e_any tb in - let uu___7 = - try_unembed - (FStar_Syntax_Embeddings.e_sealed - FStar_Syntax_Embeddings.e_any) s in - let uu___8 = - try_unembed FStar_Syntax_Embeddings.e_any f in - (uu___5, uu___6, uu___7, uu___8) in - (match uu___4 with - | (FStar_Pervasives_Native.Some ta1, - FStar_Pervasives_Native.Some tb1, - FStar_Pervasives_Native.Some s1, - FStar_Pervasives_Native.Some f1) -> - let r = - let uu___5 = - let uu___6 = - FStar_Syntax_Syntax.as_arg - (FStar_Compiler_Sealed.unseal s1) in - [uu___6] in - FStar_Syntax_Util.mk_app f1 uu___5 in - let emb = - FStar_Syntax_Embeddings_Base.set_type ta1 - FStar_Syntax_Embeddings.e_any in - let uu___5 = - FStar_TypeChecker_Primops_Base.embed_simple - (FStar_Syntax_Embeddings.e_sealed emb) - psc.FStar_TypeChecker_Primops_Base.psc_range - (FStar_Compiler_Sealed.seal r) in - FStar_Pervasives_Native.Some uu___5 - | uu___5 -> FStar_Pervasives_Native.None) - | uu___ -> FStar_Pervasives_Native.None)), - ((fun cb -> - fun univs -> - fun args -> - match args with - | (ta, uu___)::(tb, uu___1)::(s, uu___2)::(f, uu___3)::[] -> - let try_unembed e x = - FStar_TypeChecker_NBETerm.unembed e bogus_cbs x in - let uu___4 = - let uu___5 = - try_unembed FStar_TypeChecker_NBETerm.e_any ta in - let uu___6 = - try_unembed FStar_TypeChecker_NBETerm.e_any tb in - let uu___7 = - try_unembed - (FStar_TypeChecker_NBETerm.e_sealed - FStar_TypeChecker_NBETerm.e_any) s in - let uu___8 = - try_unembed FStar_TypeChecker_NBETerm.e_any f in - (uu___5, uu___6, uu___7, uu___8) in - (match uu___4 with - | (FStar_Pervasives_Native.Some ta1, - FStar_Pervasives_Native.Some tb1, - FStar_Pervasives_Native.Some s1, - FStar_Pervasives_Native.Some f1) -> - let r = - let uu___5 = - let uu___6 = - FStar_TypeChecker_NBETerm.as_arg - (FStar_Compiler_Sealed.unseal s1) in - [uu___6] in - cb.FStar_TypeChecker_NBETerm.iapp f1 uu___5 in - let emb = - FStar_TypeChecker_NBETerm.set_type ta1 - FStar_TypeChecker_NBETerm.e_any in - let uu___5 = - FStar_TypeChecker_NBETerm.embed - (FStar_TypeChecker_NBETerm.e_sealed emb) cb - (FStar_Compiler_Sealed.seal r) in - FStar_Pervasives_Native.Some uu___5 - | uu___5 -> FStar_Pervasives_Native.None) - | uu___ -> FStar_Pervasives_Native.None))); - (FStar_Parser_Const.bind_seal_lid, (Prims.of_int (4)), - (Prims.of_int (2)), - ((fun psc -> - fun univs -> - fun cbs -> - fun args -> - match args with - | (ta, uu___)::(tb, uu___1)::(s, uu___2)::(f, uu___3)::[] -> - let try_unembed e x = - FStar_Syntax_Embeddings_Base.try_unembed e x - FStar_Syntax_Embeddings_Base.id_norm_cb in - let uu___4 = - let uu___5 = - try_unembed FStar_Syntax_Embeddings.e_any ta in - let uu___6 = - try_unembed FStar_Syntax_Embeddings.e_any tb in - let uu___7 = - try_unembed - (FStar_Syntax_Embeddings.e_sealed - FStar_Syntax_Embeddings.e_any) s in - let uu___8 = - try_unembed FStar_Syntax_Embeddings.e_any f in - (uu___5, uu___6, uu___7, uu___8) in - (match uu___4 with - | (FStar_Pervasives_Native.Some ta1, - FStar_Pervasives_Native.Some tb1, - FStar_Pervasives_Native.Some s1, - FStar_Pervasives_Native.Some f1) -> - let r = - let uu___5 = - let uu___6 = - FStar_Syntax_Syntax.as_arg - (FStar_Compiler_Sealed.unseal s1) in - [uu___6] in - FStar_Syntax_Util.mk_app f1 uu___5 in - let uu___5 = - FStar_TypeChecker_Primops_Base.embed_simple - FStar_Syntax_Embeddings.e_any - psc.FStar_TypeChecker_Primops_Base.psc_range r in - FStar_Pervasives_Native.Some uu___5 - | uu___5 -> FStar_Pervasives_Native.None) - | uu___ -> FStar_Pervasives_Native.None)), - ((fun cb -> - fun univs -> - fun args -> - match args with - | (ta, uu___)::(tb, uu___1)::(s, uu___2)::(f, uu___3)::[] -> - let try_unembed e x = - FStar_TypeChecker_NBETerm.unembed e bogus_cbs x in - let uu___4 = - let uu___5 = - try_unembed FStar_TypeChecker_NBETerm.e_any ta in - let uu___6 = - try_unembed FStar_TypeChecker_NBETerm.e_any tb in - let uu___7 = - try_unembed - (FStar_TypeChecker_NBETerm.e_sealed - FStar_TypeChecker_NBETerm.e_any) s in - let uu___8 = - try_unembed FStar_TypeChecker_NBETerm.e_any f in - (uu___5, uu___6, uu___7, uu___8) in - (match uu___4 with - | (FStar_Pervasives_Native.Some ta1, - FStar_Pervasives_Native.Some tb1, - FStar_Pervasives_Native.Some s1, - FStar_Pervasives_Native.Some f1) -> - let r = - let uu___5 = - let uu___6 = - FStar_TypeChecker_NBETerm.as_arg - (FStar_Compiler_Sealed.unseal s1) in - [uu___6] in - cb.FStar_TypeChecker_NBETerm.iapp f1 uu___5 in - let emb = - FStar_TypeChecker_NBETerm.set_type ta1 - FStar_TypeChecker_NBETerm.e_any in - let uu___5 = FStar_TypeChecker_NBETerm.embed emb cb r in - FStar_Pervasives_Native.Some uu___5 - | uu___5 -> FStar_Pervasives_Native.None) - | uu___ -> FStar_Pervasives_Native.None)))] -let (array_ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = - let of_list_op = - let emb_typ t = - let uu___ = - let uu___1 = - FStar_Ident.string_of_lid FStar_Parser_Const.immutable_array_t_lid in - (uu___1, [t]) in - FStar_Syntax_Syntax.ET_app uu___ in - let un_lazy universes t l r = - let uu___ = - let uu___1 = - FStar_Syntax_Util.fvar_const - FStar_Parser_Const.immutable_array_of_list_lid in - FStar_Syntax_Syntax.mk_Tm_uinst uu___1 universes in - let uu___1 = - let uu___2 = FStar_Syntax_Syntax.iarg t in - let uu___3 = let uu___4 = FStar_Syntax_Syntax.as_arg l in [uu___4] in - uu___2 :: uu___3 in - FStar_Syntax_Syntax.mk_Tm_app uu___ uu___1 r in - (FStar_Parser_Const.immutable_array_of_list_lid, (Prims.of_int (2)), - Prims.int_one, - (mixed_binary_op - (fun uu___ -> - match uu___ with - | (elt_t, uu___1) -> FStar_Pervasives_Native.Some elt_t) - (fun uu___ -> - match uu___ with - | (l, q) -> - let uu___1 = arg_as_list FStar_Syntax_Embeddings.e_any (l, q) in - (match uu___1 with - | FStar_Pervasives_Native.Some lst -> - FStar_Pervasives_Native.Some (l, lst) - | uu___2 -> FStar_Pervasives_Native.None)) - (fun r -> - fun uu___ -> - match uu___ with - | (universes, elt_t, (l, blob)) -> - let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = - FStar_Syntax_Embeddings_Base.emb_typ_of - FStar_Syntax_Embeddings.e_any () in - emb_typ uu___6 in - let uu___6 = - FStar_Thunk.mk - (fun uu___7 -> un_lazy universes elt_t l r) in - (uu___5, uu___6) in - FStar_Syntax_Syntax.Lazy_embedding uu___4 in - let uu___4 = - let uu___5 = - let uu___6 = - FStar_Syntax_Util.fvar_const - FStar_Parser_Const.immutable_array_t_lid in - FStar_Syntax_Syntax.mk_Tm_uinst uu___6 universes in - let uu___6 = - let uu___7 = FStar_Syntax_Syntax.as_arg elt_t in - [uu___7] in - FStar_Syntax_Syntax.mk_Tm_app uu___5 uu___6 r in - { - FStar_Syntax_Syntax.blob = blob; - FStar_Syntax_Syntax.lkind = uu___3; - FStar_Syntax_Syntax.ltyp = uu___4; - FStar_Syntax_Syntax.rng = r - } in - FStar_Syntax_Syntax.Tm_lazy uu___2 in - FStar_Syntax_Syntax.mk uu___1 r) - (fun r -> - fun universes -> - fun elt_t -> - fun uu___ -> - match uu___ with - | (l, lst) -> - let blob = FStar_ImmutableArray_Base.of_list lst in - let uu___1 = - let uu___2 = - let uu___3 = FStar_Compiler_Dyn.mkdyn blob in - (l, uu___3) in - (universes, elt_t, uu___2) in - FStar_Pervasives_Native.Some uu___1)), - (FStar_TypeChecker_NBETerm.mixed_binary_op - (fun uu___ -> - match uu___ with - | (elt_t, uu___1) -> FStar_Pervasives_Native.Some elt_t) - (fun uu___ -> - match uu___ with - | (l, q) -> - let uu___1 = - FStar_TypeChecker_NBETerm.arg_as_list - FStar_TypeChecker_NBETerm.e_any (l, q) in - (match uu___1 with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some lst -> - FStar_Pervasives_Native.Some (l, lst))) - (fun uu___ -> - match uu___ with - | (universes, elt_t, (l, blob)) -> - let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = - FStar_Syntax_Embeddings_Base.emb_typ_of - FStar_Syntax_Embeddings.e_any () in - emb_typ uu___6 in - (blob, uu___5) in - FStar_Pervasives.Inr uu___4 in - let uu___4 = - FStar_Thunk.mk - (fun uu___5 -> - let uu___6 = - let uu___7 = - let uu___8 = - FStar_Syntax_Syntax.lid_as_fv - FStar_Parser_Const.immutable_array_of_list_lid - FStar_Pervasives_Native.None in - let uu___9 = - let uu___10 = - FStar_TypeChecker_NBETerm.as_arg l in - [uu___10] in - (uu___8, universes, uu___9) in - FStar_TypeChecker_NBETerm.FV uu___7 in - FStar_TypeChecker_NBETerm.mk_t uu___6) in - (uu___3, uu___4) in - FStar_TypeChecker_NBETerm.Lazy uu___2 in - FStar_TypeChecker_NBETerm.mk_t uu___1) - (fun universes -> - fun elt_t -> - fun uu___ -> - match uu___ with - | (l, lst) -> - let blob = FStar_ImmutableArray_Base.of_list lst in - let uu___1 = - let uu___2 = - let uu___3 = FStar_Compiler_Dyn.mkdyn blob in - (l, uu___3) in - (universes, elt_t, uu___2) in - FStar_Pervasives_Native.Some uu___1))) in - let arg1_as_elt_t x = - FStar_Pervasives_Native.Some (FStar_Pervasives_Native.fst x) in - let arg2_as_blob x = - let uu___ = - let uu___1 = - FStar_Syntax_Subst.compress (FStar_Pervasives_Native.fst x) in - uu___1.FStar_Syntax_Syntax.n in - match uu___ with - | FStar_Syntax_Syntax.Tm_lazy - { FStar_Syntax_Syntax.blob = blob; - FStar_Syntax_Syntax.lkind = FStar_Syntax_Syntax.Lazy_embedding - (FStar_Syntax_Syntax.ET_app (head, uu___1), uu___2); - FStar_Syntax_Syntax.ltyp = uu___3; - FStar_Syntax_Syntax.rng = uu___4;_} - when - let uu___5 = - FStar_Ident.string_of_lid FStar_Parser_Const.immutable_array_t_lid in - head = uu___5 -> FStar_Pervasives_Native.Some blob - | uu___1 -> FStar_Pervasives_Native.None in - let arg2_as_blob_nbe x = - match (FStar_Pervasives_Native.fst x).FStar_TypeChecker_NBETerm.nbe_t - with - | FStar_TypeChecker_NBETerm.Lazy - (FStar_Pervasives.Inr - (blob, FStar_Syntax_Syntax.ET_app (head, uu___)), uu___1) - when - let uu___2 = - FStar_Ident.string_of_lid FStar_Parser_Const.immutable_array_t_lid in - head = uu___2 -> FStar_Pervasives_Native.Some blob - | uu___ -> FStar_Pervasives_Native.None in - let length_op = - let embed_int r i = - FStar_TypeChecker_Primops_Base.embed_simple - FStar_Syntax_Embeddings.e_int r i in - let run_op blob = - let uu___ = - let uu___1 = FStar_Compiler_Dyn.undyn blob in - FStar_Compiler_Util.array_length uu___1 in - FStar_Pervasives_Native.Some uu___ in - (FStar_Parser_Const.immutable_array_length_lid, (Prims.of_int (2)), - Prims.int_one, - (mixed_binary_op arg1_as_elt_t arg2_as_blob embed_int - (fun _r -> fun _universes -> fun uu___ -> fun blob -> run_op blob)), - (FStar_TypeChecker_NBETerm.mixed_binary_op - (fun uu___ -> - match uu___ with - | (elt_t, uu___1) -> FStar_Pervasives_Native.Some elt_t) - arg2_as_blob_nbe - (fun i -> - FStar_TypeChecker_NBETerm.embed FStar_TypeChecker_NBETerm.e_int - bogus_cbs i) - (fun _universes -> fun uu___ -> fun blob -> run_op blob))) in - let index_op = - (FStar_Parser_Const.immutable_array_index_lid, (Prims.of_int (3)), - Prims.int_one, - (mixed_ternary_op arg1_as_elt_t arg2_as_blob arg_as_int - (fun r -> fun tm -> tm) - (fun r -> - fun _universes -> - fun _t -> - fun blob -> - fun i -> - let uu___ = - let uu___1 = FStar_Compiler_Dyn.undyn blob in - FStar_Compiler_Util.array_index uu___1 i in - FStar_Pervasives_Native.Some uu___)), - (FStar_TypeChecker_NBETerm.mixed_ternary_op - (fun uu___ -> - match uu___ with - | (elt_t, uu___1) -> FStar_Pervasives_Native.Some elt_t) - arg2_as_blob_nbe FStar_TypeChecker_NBETerm.arg_as_int (fun tm -> tm) - (fun _universes -> - fun _t -> - fun blob -> - fun i -> - let uu___ = - let uu___1 = FStar_Compiler_Dyn.undyn blob in - FStar_Compiler_Util.array_index uu___1 i in - FStar_Pervasives_Native.Some uu___))) in - FStar_Compiler_List.map (as_primitive_step true) - [of_list_op; length_op; index_op] let (short_circuit_ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Compiler_List.map (as_primitive_step true) @@ -1137,16 +446,18 @@ let (built_in_primitive_steps_list : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Compiler_List.op_At simple_ops (FStar_Compiler_List.op_At short_circuit_ops - (FStar_Compiler_List.op_At issue_ops - (FStar_Compiler_List.op_At array_ops - (FStar_Compiler_List.op_At seal_steps + (FStar_Compiler_List.op_At FStar_TypeChecker_Primops_Issue.ops + (FStar_Compiler_List.op_At FStar_TypeChecker_Primops_Array.ops + (FStar_Compiler_List.op_At FStar_TypeChecker_Primops_Sealed.ops (FStar_Compiler_List.op_At FStar_TypeChecker_Primops_Erased.ops (FStar_Compiler_List.op_At FStar_TypeChecker_Primops_Docs.ops (FStar_Compiler_List.op_At FStar_TypeChecker_Primops_MachineInts.ops - FStar_TypeChecker_Primops_Errors_Msg.ops))))))) + (FStar_Compiler_List.op_At + FStar_TypeChecker_Primops_Errors_Msg.ops + FStar_TypeChecker_Primops_Range.ops)))))))) let (equality_ops_list : FStar_TypeChecker_Env.env_t -> FStar_TypeChecker_Primops_Base.primitive_step Prims.list) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Array.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Array.ml new file mode 100644 index 00000000000..dee26997e27 --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Array.ml @@ -0,0 +1,354 @@ +open Prims +let (as_primitive_step : + Prims.bool -> + (FStar_Ident.lident * Prims.int * Prims.int * + FStar_TypeChecker_Primops_Base.interp_t * + (FStar_Syntax_Syntax.universes -> + FStar_TypeChecker_NBETerm.args -> + FStar_TypeChecker_NBETerm.t FStar_Pervasives_Native.option)) + -> FStar_TypeChecker_Primops_Base.primitive_step) + = + fun is_strong -> + fun uu___ -> + match uu___ with + | (l, arity, u_arity, f, f_nbe) -> + FStar_TypeChecker_Primops_Base.as_primitive_step_nbecbs is_strong + (l, arity, u_arity, f, + (fun cb -> fun univs -> fun args -> f_nbe univs args)) +let (arg_as_int : + FStar_Syntax_Syntax.arg -> FStar_BigInt.t FStar_Pervasives_Native.option) = + fun a -> + FStar_TypeChecker_Primops_Base.try_unembed_simple + FStar_Syntax_Embeddings.e_int (FStar_Pervasives_Native.fst a) +let arg_as_list : + 'a . + 'a FStar_Syntax_Embeddings_Base.embedding -> + FStar_Syntax_Syntax.arg -> 'a Prims.list FStar_Pervasives_Native.option + = + fun e -> + fun a1 -> + FStar_TypeChecker_Primops_Base.try_unembed_simple + (FStar_Syntax_Embeddings.e_list e) (FStar_Pervasives_Native.fst a1) +let mixed_binary_op : + 'a 'b 'c . + (FStar_Syntax_Syntax.arg -> 'a FStar_Pervasives_Native.option) -> + (FStar_Syntax_Syntax.arg -> 'b FStar_Pervasives_Native.option) -> + (FStar_Compiler_Range_Type.range -> 'c -> FStar_Syntax_Syntax.term) + -> + (FStar_Compiler_Range_Type.range -> + FStar_Syntax_Syntax.universes -> + 'a -> 'b -> 'c FStar_Pervasives_Native.option) + -> + FStar_TypeChecker_Primops_Base.psc -> + FStar_Syntax_Embeddings_Base.norm_cb -> + FStar_Syntax_Syntax.universes -> + FStar_Syntax_Syntax.args -> + FStar_Syntax_Syntax.term FStar_Pervasives_Native.option + = + fun as_a -> + fun as_b -> + fun embed_c -> + fun f -> + fun psc -> + fun norm_cb -> + fun univs -> + fun args -> + match args with + | a1::b1::[] -> + let uu___ = + let uu___1 = as_a a1 in + let uu___2 = as_b b1 in (uu___1, uu___2) in + (match uu___ with + | (FStar_Pervasives_Native.Some a2, + FStar_Pervasives_Native.Some b2) -> + let uu___1 = + f psc.FStar_TypeChecker_Primops_Base.psc_range + univs a2 b2 in + (match uu___1 with + | FStar_Pervasives_Native.Some c1 -> + let uu___2 = + embed_c + psc.FStar_TypeChecker_Primops_Base.psc_range + c1 in + FStar_Pervasives_Native.Some uu___2 + | uu___2 -> FStar_Pervasives_Native.None) + | uu___1 -> FStar_Pervasives_Native.None) + | uu___ -> FStar_Pervasives_Native.None +let mixed_ternary_op : + 'a 'b 'c 'd . + (FStar_Syntax_Syntax.arg -> 'a FStar_Pervasives_Native.option) -> + (FStar_Syntax_Syntax.arg -> 'b FStar_Pervasives_Native.option) -> + (FStar_Syntax_Syntax.arg -> 'c FStar_Pervasives_Native.option) -> + (FStar_Compiler_Range_Type.range -> 'd -> FStar_Syntax_Syntax.term) + -> + (FStar_Compiler_Range_Type.range -> + FStar_Syntax_Syntax.universes -> + 'a -> 'b -> 'c -> 'd FStar_Pervasives_Native.option) + -> + FStar_TypeChecker_Primops_Base.psc -> + FStar_Syntax_Embeddings_Base.norm_cb -> + FStar_Syntax_Syntax.universes -> + FStar_Syntax_Syntax.args -> + FStar_Syntax_Syntax.term FStar_Pervasives_Native.option + = + fun as_a -> + fun as_b -> + fun as_c -> + fun embed_d -> + fun f -> + fun psc -> + fun norm_cb -> + fun univs -> + fun args -> + match args with + | a1::b1::c1::[] -> + let uu___ = + let uu___1 = as_a a1 in + let uu___2 = as_b b1 in + let uu___3 = as_c c1 in (uu___1, uu___2, uu___3) in + (match uu___ with + | (FStar_Pervasives_Native.Some a2, + FStar_Pervasives_Native.Some b2, + FStar_Pervasives_Native.Some c2) -> + let uu___1 = + f psc.FStar_TypeChecker_Primops_Base.psc_range + univs a2 b2 c2 in + (match uu___1 with + | FStar_Pervasives_Native.Some d1 -> + let uu___2 = + embed_d + psc.FStar_TypeChecker_Primops_Base.psc_range + d1 in + FStar_Pervasives_Native.Some uu___2 + | uu___2 -> FStar_Pervasives_Native.None) + | uu___1 -> FStar_Pervasives_Native.None) + | uu___ -> FStar_Pervasives_Native.None +let (bogus_cbs : FStar_TypeChecker_NBETerm.nbe_cbs) = + { + FStar_TypeChecker_NBETerm.iapp = (fun h -> fun _args -> h); + FStar_TypeChecker_NBETerm.translate = + (fun uu___ -> FStar_Compiler_Effect.failwith "bogus_cbs translate") + } +let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = + let of_list_op = + let emb_typ t = + let uu___ = + let uu___1 = + FStar_Ident.string_of_lid FStar_Parser_Const.immutable_array_t_lid in + (uu___1, [t]) in + FStar_Syntax_Syntax.ET_app uu___ in + let un_lazy universes t l r = + let uu___ = + let uu___1 = + FStar_Syntax_Util.fvar_const + FStar_Parser_Const.immutable_array_of_list_lid in + FStar_Syntax_Syntax.mk_Tm_uinst uu___1 universes in + let uu___1 = + let uu___2 = FStar_Syntax_Syntax.iarg t in + let uu___3 = let uu___4 = FStar_Syntax_Syntax.as_arg l in [uu___4] in + uu___2 :: uu___3 in + FStar_Syntax_Syntax.mk_Tm_app uu___ uu___1 r in + (FStar_Parser_Const.immutable_array_of_list_lid, (Prims.of_int (2)), + Prims.int_one, + (mixed_binary_op + (fun uu___ -> + match uu___ with + | (elt_t, uu___1) -> FStar_Pervasives_Native.Some elt_t) + (fun uu___ -> + match uu___ with + | (l, q) -> + let uu___1 = arg_as_list FStar_Syntax_Embeddings.e_any (l, q) in + (match uu___1 with + | FStar_Pervasives_Native.Some lst -> + FStar_Pervasives_Native.Some (l, lst) + | uu___2 -> FStar_Pervasives_Native.None)) + (fun r -> + fun uu___ -> + match uu___ with + | (universes, elt_t, (l, blob)) -> + let uu___1 = + let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = + let uu___6 = + FStar_Syntax_Embeddings_Base.emb_typ_of + FStar_Syntax_Embeddings.e_any () in + emb_typ uu___6 in + let uu___6 = + FStar_Thunk.mk + (fun uu___7 -> un_lazy universes elt_t l r) in + (uu___5, uu___6) in + FStar_Syntax_Syntax.Lazy_embedding uu___4 in + let uu___4 = + let uu___5 = + let uu___6 = + FStar_Syntax_Util.fvar_const + FStar_Parser_Const.immutable_array_t_lid in + FStar_Syntax_Syntax.mk_Tm_uinst uu___6 universes in + let uu___6 = + let uu___7 = FStar_Syntax_Syntax.as_arg elt_t in + [uu___7] in + FStar_Syntax_Syntax.mk_Tm_app uu___5 uu___6 r in + { + FStar_Syntax_Syntax.blob = blob; + FStar_Syntax_Syntax.lkind = uu___3; + FStar_Syntax_Syntax.ltyp = uu___4; + FStar_Syntax_Syntax.rng = r + } in + FStar_Syntax_Syntax.Tm_lazy uu___2 in + FStar_Syntax_Syntax.mk uu___1 r) + (fun r -> + fun universes -> + fun elt_t -> + fun uu___ -> + match uu___ with + | (l, lst) -> + let blob = FStar_ImmutableArray_Base.of_list lst in + let uu___1 = + let uu___2 = + let uu___3 = FStar_Compiler_Dyn.mkdyn blob in + (l, uu___3) in + (universes, elt_t, uu___2) in + FStar_Pervasives_Native.Some uu___1)), + (FStar_TypeChecker_NBETerm.mixed_binary_op + (fun uu___ -> + match uu___ with + | (elt_t, uu___1) -> FStar_Pervasives_Native.Some elt_t) + (fun uu___ -> + match uu___ with + | (l, q) -> + let uu___1 = + FStar_TypeChecker_NBETerm.arg_as_list + FStar_TypeChecker_NBETerm.e_any (l, q) in + (match uu___1 with + | FStar_Pervasives_Native.None -> + FStar_Pervasives_Native.None + | FStar_Pervasives_Native.Some lst -> + FStar_Pervasives_Native.Some (l, lst))) + (fun uu___ -> + match uu___ with + | (universes, elt_t, (l, blob)) -> + let uu___1 = + let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = + let uu___6 = + FStar_Syntax_Embeddings_Base.emb_typ_of + FStar_Syntax_Embeddings.e_any () in + emb_typ uu___6 in + (blob, uu___5) in + FStar_Pervasives.Inr uu___4 in + let uu___4 = + FStar_Thunk.mk + (fun uu___5 -> + let uu___6 = + let uu___7 = + let uu___8 = + FStar_Syntax_Syntax.lid_as_fv + FStar_Parser_Const.immutable_array_of_list_lid + FStar_Pervasives_Native.None in + let uu___9 = + let uu___10 = + FStar_TypeChecker_NBETerm.as_arg l in + [uu___10] in + (uu___8, universes, uu___9) in + FStar_TypeChecker_NBETerm.FV uu___7 in + FStar_TypeChecker_NBETerm.mk_t uu___6) in + (uu___3, uu___4) in + FStar_TypeChecker_NBETerm.Lazy uu___2 in + FStar_TypeChecker_NBETerm.mk_t uu___1) + (fun universes -> + fun elt_t -> + fun uu___ -> + match uu___ with + | (l, lst) -> + let blob = FStar_ImmutableArray_Base.of_list lst in + let uu___1 = + let uu___2 = + let uu___3 = FStar_Compiler_Dyn.mkdyn blob in + (l, uu___3) in + (universes, elt_t, uu___2) in + FStar_Pervasives_Native.Some uu___1))) in + let arg1_as_elt_t x = + FStar_Pervasives_Native.Some (FStar_Pervasives_Native.fst x) in + let arg2_as_blob x = + let uu___ = + let uu___1 = + FStar_Syntax_Subst.compress (FStar_Pervasives_Native.fst x) in + uu___1.FStar_Syntax_Syntax.n in + match uu___ with + | FStar_Syntax_Syntax.Tm_lazy + { FStar_Syntax_Syntax.blob = blob; + FStar_Syntax_Syntax.lkind = FStar_Syntax_Syntax.Lazy_embedding + (FStar_Syntax_Syntax.ET_app (head, uu___1), uu___2); + FStar_Syntax_Syntax.ltyp = uu___3; + FStar_Syntax_Syntax.rng = uu___4;_} + when + let uu___5 = + FStar_Ident.string_of_lid FStar_Parser_Const.immutable_array_t_lid in + head = uu___5 -> FStar_Pervasives_Native.Some blob + | uu___1 -> FStar_Pervasives_Native.None in + let arg2_as_blob_nbe x = + match (FStar_Pervasives_Native.fst x).FStar_TypeChecker_NBETerm.nbe_t + with + | FStar_TypeChecker_NBETerm.Lazy + (FStar_Pervasives.Inr + (blob, FStar_Syntax_Syntax.ET_app (head, uu___)), uu___1) + when + let uu___2 = + FStar_Ident.string_of_lid FStar_Parser_Const.immutable_array_t_lid in + head = uu___2 -> FStar_Pervasives_Native.Some blob + | uu___ -> FStar_Pervasives_Native.None in + let length_op = + let embed_int r i = + FStar_TypeChecker_Primops_Base.embed_simple + FStar_Syntax_Embeddings.e_int r i in + let run_op blob = + let uu___ = + let uu___1 = FStar_Compiler_Dyn.undyn blob in + FStar_Compiler_Util.array_length uu___1 in + FStar_Pervasives_Native.Some uu___ in + (FStar_Parser_Const.immutable_array_length_lid, (Prims.of_int (2)), + Prims.int_one, + (mixed_binary_op arg1_as_elt_t arg2_as_blob embed_int + (fun _r -> fun _universes -> fun uu___ -> fun blob -> run_op blob)), + (FStar_TypeChecker_NBETerm.mixed_binary_op + (fun uu___ -> + match uu___ with + | (elt_t, uu___1) -> FStar_Pervasives_Native.Some elt_t) + arg2_as_blob_nbe + (fun i -> + FStar_TypeChecker_NBETerm.embed FStar_TypeChecker_NBETerm.e_int + bogus_cbs i) + (fun _universes -> fun uu___ -> fun blob -> run_op blob))) in + let index_op = + (FStar_Parser_Const.immutable_array_index_lid, (Prims.of_int (3)), + Prims.int_one, + (mixed_ternary_op arg1_as_elt_t arg2_as_blob arg_as_int + (fun r -> fun tm -> tm) + (fun r -> + fun _universes -> + fun _t -> + fun blob -> + fun i -> + let uu___ = + let uu___1 = FStar_Compiler_Dyn.undyn blob in + FStar_Compiler_Util.array_index uu___1 i in + FStar_Pervasives_Native.Some uu___)), + (FStar_TypeChecker_NBETerm.mixed_ternary_op + (fun uu___ -> + match uu___ with + | (elt_t, uu___1) -> FStar_Pervasives_Native.Some elt_t) + arg2_as_blob_nbe FStar_TypeChecker_NBETerm.arg_as_int (fun tm -> tm) + (fun _universes -> + fun _t -> + fun blob -> + fun i -> + let uu___ = + let uu___1 = FStar_Compiler_Dyn.undyn blob in + FStar_Compiler_Util.array_index uu___1 i in + FStar_Pervasives_Native.Some uu___))) in + FStar_Compiler_List.map (as_primitive_step true) + [of_list_op; length_op; index_op] \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Issue.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Issue.ml new file mode 100644 index 00000000000..85e367274c4 --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Issue.ml @@ -0,0 +1,108 @@ +open Prims +let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = + let mk_lid l = FStar_Parser_Const.p2l ["FStar"; "Issue"; l] in + let uu___ = + let uu___1 = mk_lid "message_of_issue" in + FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___1 + FStar_Syntax_Embeddings.e_issue FStar_TypeChecker_NBETerm.e_issue + (FStar_Syntax_Embeddings.e_list FStar_Syntax_Embeddings.e_document) + (FStar_TypeChecker_NBETerm.e_list FStar_TypeChecker_NBETerm.e_document) + FStar_Errors.__proj__Mkissue__item__issue_msg in + let uu___1 = + let uu___2 = + let uu___3 = mk_lid "level_of_issue" in + FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___3 + FStar_Syntax_Embeddings.e_issue FStar_TypeChecker_NBETerm.e_issue + FStar_Syntax_Embeddings.e_string FStar_TypeChecker_NBETerm.e_string + (fun i -> + FStar_Errors.string_of_issue_level i.FStar_Errors.issue_level) in + let uu___3 = + let uu___4 = + let uu___5 = mk_lid "number_of_issue" in + FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___5 + FStar_Syntax_Embeddings.e_issue FStar_TypeChecker_NBETerm.e_issue + (FStar_Syntax_Embeddings.e_option FStar_Syntax_Embeddings.e_int) + (FStar_TypeChecker_NBETerm.e_option FStar_TypeChecker_NBETerm.e_int) + (fun uu___6 -> + (fun i -> + Obj.magic + (FStar_Class_Monad.fmap FStar_Class_Monad.monad_option () + () + (fun uu___6 -> (Obj.magic FStar_BigInt.of_int_fs) uu___6) + (Obj.magic i.FStar_Errors.issue_number))) uu___6) in + let uu___5 = + let uu___6 = + let uu___7 = mk_lid "range_of_issue" in + FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___7 + FStar_Syntax_Embeddings.e_issue FStar_TypeChecker_NBETerm.e_issue + (FStar_Syntax_Embeddings.e_option FStar_Syntax_Embeddings.e_range) + (FStar_TypeChecker_NBETerm.e_option + FStar_TypeChecker_NBETerm.e_range) + FStar_Errors.__proj__Mkissue__item__issue_range in + let uu___7 = + let uu___8 = + let uu___9 = mk_lid "context_of_issue" in + FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___9 + FStar_Syntax_Embeddings.e_issue + FStar_TypeChecker_NBETerm.e_issue + FStar_Syntax_Embeddings.e_string_list + FStar_TypeChecker_NBETerm.e_string_list + FStar_Errors.__proj__Mkissue__item__issue_ctx in + let uu___9 = + let uu___10 = + let uu___11 = mk_lid "render_issue" in + FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___11 + FStar_Syntax_Embeddings.e_issue + FStar_TypeChecker_NBETerm.e_issue + FStar_Syntax_Embeddings.e_string + FStar_TypeChecker_NBETerm.e_string FStar_Errors.format_issue in + let uu___11 = + let uu___12 = + let uu___13 = mk_lid "mk_issue_doc" in + FStar_TypeChecker_Primops_Base.mk5 Prims.int_zero uu___13 + FStar_Syntax_Embeddings.e_string + FStar_TypeChecker_NBETerm.e_string + (FStar_Syntax_Embeddings.e_list + FStar_Syntax_Embeddings.e_document) + (FStar_TypeChecker_NBETerm.e_list + FStar_TypeChecker_NBETerm.e_document) + (FStar_Syntax_Embeddings.e_option + FStar_Syntax_Embeddings.e_range) + (FStar_TypeChecker_NBETerm.e_option + FStar_TypeChecker_NBETerm.e_range) + (FStar_Syntax_Embeddings.e_option + FStar_Syntax_Embeddings.e_int) + (FStar_TypeChecker_NBETerm.e_option + FStar_TypeChecker_NBETerm.e_int) + FStar_Syntax_Embeddings.e_string_list + FStar_TypeChecker_NBETerm.e_string_list + FStar_Syntax_Embeddings.e_issue + FStar_TypeChecker_NBETerm.e_issue + (fun level -> + fun msg -> + fun range -> + fun number -> + fun context -> + let uu___14 = + FStar_Errors.issue_level_of_string level in + let uu___15 = + Obj.magic + (FStar_Class_Monad.fmap + FStar_Class_Monad.monad_option () () + (fun uu___16 -> + (Obj.magic FStar_BigInt.to_int_fs) + uu___16) (Obj.magic number)) in + { + FStar_Errors.issue_msg = msg; + FStar_Errors.issue_level = uu___14; + FStar_Errors.issue_range = range; + FStar_Errors.issue_number = uu___15; + FStar_Errors.issue_ctx = context + }) in + [uu___12] in + uu___10 :: uu___11 in + uu___8 :: uu___9 in + uu___6 :: uu___7 in + uu___4 :: uu___5 in + uu___2 :: uu___3 in + uu___ :: uu___1 \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Range.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Range.ml new file mode 100644 index 00000000000..426a3fb43ac --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Range.ml @@ -0,0 +1,35 @@ +open Prims +let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = + let uu___ = + FStar_TypeChecker_Primops_Base.mk5 Prims.int_zero + FStar_Parser_Const.mk_range_lid FStar_Syntax_Embeddings.e_string + FStar_TypeChecker_NBETerm.e_string FStar_Syntax_Embeddings.e_int + FStar_TypeChecker_NBETerm.e_int FStar_Syntax_Embeddings.e_int + FStar_TypeChecker_NBETerm.e_int FStar_Syntax_Embeddings.e_int + FStar_TypeChecker_NBETerm.e_int FStar_Syntax_Embeddings.e_int + FStar_TypeChecker_NBETerm.e_int FStar_Syntax_Embeddings.e_range + FStar_TypeChecker_NBETerm.e_range + (fun fn -> + fun from_l -> + fun from_c -> + fun to_l -> + fun to_c -> + let uu___1 = + let uu___2 = FStar_BigInt.to_int_fs from_l in + let uu___3 = FStar_BigInt.to_int_fs from_c in + FStar_Compiler_Range_Type.mk_pos uu___2 uu___3 in + let uu___2 = + let uu___3 = FStar_BigInt.to_int_fs to_l in + let uu___4 = FStar_BigInt.to_int_fs to_c in + FStar_Compiler_Range_Type.mk_pos uu___3 uu___4 in + FStar_Compiler_Range_Type.mk_range fn uu___1 uu___2) in + let uu___1 = + let uu___2 = + FStar_TypeChecker_Primops_Base.mk2 Prims.int_zero + FStar_Parser_Const.join_range_lid FStar_Syntax_Embeddings.e_range + FStar_TypeChecker_NBETerm.e_range FStar_Syntax_Embeddings.e_range + FStar_TypeChecker_NBETerm.e_range FStar_Syntax_Embeddings.e_range + FStar_TypeChecker_NBETerm.e_range + FStar_Compiler_Range_Ops.union_ranges in + [uu___2] in + uu___ :: uu___1 \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Sealed.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Sealed.ml new file mode 100644 index 00000000000..e4896738c37 --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Sealed.ml @@ -0,0 +1,198 @@ +open Prims +let (bogus_cbs : FStar_TypeChecker_NBETerm.nbe_cbs) = + { + FStar_TypeChecker_NBETerm.iapp = (fun h -> fun _args -> h); + FStar_TypeChecker_NBETerm.translate = + (fun uu___ -> FStar_Compiler_Effect.failwith "bogus_cbs translate") + } +let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = + FStar_Compiler_List.map + (fun p -> + let uu___ = + FStar_TypeChecker_Primops_Base.as_primitive_step_nbecbs true p in + { + FStar_TypeChecker_Primops_Base.name = + (uu___.FStar_TypeChecker_Primops_Base.name); + FStar_TypeChecker_Primops_Base.arity = + (uu___.FStar_TypeChecker_Primops_Base.arity); + FStar_TypeChecker_Primops_Base.univ_arity = + (uu___.FStar_TypeChecker_Primops_Base.univ_arity); + FStar_TypeChecker_Primops_Base.auto_reflect = + (uu___.FStar_TypeChecker_Primops_Base.auto_reflect); + FStar_TypeChecker_Primops_Base.strong_reduction_ok = + (uu___.FStar_TypeChecker_Primops_Base.strong_reduction_ok); + FStar_TypeChecker_Primops_Base.requires_binder_substitution = + (uu___.FStar_TypeChecker_Primops_Base.requires_binder_substitution); + FStar_TypeChecker_Primops_Base.renorm_after = true; + FStar_TypeChecker_Primops_Base.interpretation = + (uu___.FStar_TypeChecker_Primops_Base.interpretation); + FStar_TypeChecker_Primops_Base.interpretation_nbe = + (uu___.FStar_TypeChecker_Primops_Base.interpretation_nbe) + }) + [(FStar_Parser_Const.map_seal_lid, (Prims.of_int (4)), + (Prims.of_int (2)), + ((fun psc -> + fun univs -> + fun cbs -> + fun args -> + match args with + | (ta, uu___)::(tb, uu___1)::(s, uu___2)::(f, uu___3)::[] -> + let try_unembed e x = + FStar_Syntax_Embeddings_Base.try_unembed e x + FStar_Syntax_Embeddings_Base.id_norm_cb in + let uu___4 = + let uu___5 = + try_unembed FStar_Syntax_Embeddings.e_any ta in + let uu___6 = + try_unembed FStar_Syntax_Embeddings.e_any tb in + let uu___7 = + try_unembed + (FStar_Syntax_Embeddings.e_sealed + FStar_Syntax_Embeddings.e_any) s in + let uu___8 = + try_unembed FStar_Syntax_Embeddings.e_any f in + (uu___5, uu___6, uu___7, uu___8) in + (match uu___4 with + | (FStar_Pervasives_Native.Some ta1, + FStar_Pervasives_Native.Some tb1, + FStar_Pervasives_Native.Some s1, + FStar_Pervasives_Native.Some f1) -> + let r = + let uu___5 = + let uu___6 = + FStar_Syntax_Syntax.as_arg + (FStar_Compiler_Sealed.unseal s1) in + [uu___6] in + FStar_Syntax_Util.mk_app f1 uu___5 in + let emb = + FStar_Syntax_Embeddings_Base.set_type ta1 + FStar_Syntax_Embeddings.e_any in + let uu___5 = + FStar_TypeChecker_Primops_Base.embed_simple + (FStar_Syntax_Embeddings.e_sealed emb) + psc.FStar_TypeChecker_Primops_Base.psc_range + (FStar_Compiler_Sealed.seal r) in + FStar_Pervasives_Native.Some uu___5 + | uu___5 -> FStar_Pervasives_Native.None) + | uu___ -> FStar_Pervasives_Native.None)), + ((fun cb -> + fun univs -> + fun args -> + match args with + | (ta, uu___)::(tb, uu___1)::(s, uu___2)::(f, uu___3)::[] -> + let try_unembed e x = + FStar_TypeChecker_NBETerm.unembed e bogus_cbs x in + let uu___4 = + let uu___5 = + try_unembed FStar_TypeChecker_NBETerm.e_any ta in + let uu___6 = + try_unembed FStar_TypeChecker_NBETerm.e_any tb in + let uu___7 = + try_unembed + (FStar_TypeChecker_NBETerm.e_sealed + FStar_TypeChecker_NBETerm.e_any) s in + let uu___8 = + try_unembed FStar_TypeChecker_NBETerm.e_any f in + (uu___5, uu___6, uu___7, uu___8) in + (match uu___4 with + | (FStar_Pervasives_Native.Some ta1, + FStar_Pervasives_Native.Some tb1, + FStar_Pervasives_Native.Some s1, + FStar_Pervasives_Native.Some f1) -> + let r = + let uu___5 = + let uu___6 = + FStar_TypeChecker_NBETerm.as_arg + (FStar_Compiler_Sealed.unseal s1) in + [uu___6] in + cb.FStar_TypeChecker_NBETerm.iapp f1 uu___5 in + let emb = + FStar_TypeChecker_NBETerm.set_type ta1 + FStar_TypeChecker_NBETerm.e_any in + let uu___5 = + FStar_TypeChecker_NBETerm.embed + (FStar_TypeChecker_NBETerm.e_sealed emb) cb + (FStar_Compiler_Sealed.seal r) in + FStar_Pervasives_Native.Some uu___5 + | uu___5 -> FStar_Pervasives_Native.None) + | uu___ -> FStar_Pervasives_Native.None))); + (FStar_Parser_Const.bind_seal_lid, (Prims.of_int (4)), + (Prims.of_int (2)), + ((fun psc -> + fun univs -> + fun cbs -> + fun args -> + match args with + | (ta, uu___)::(tb, uu___1)::(s, uu___2)::(f, uu___3)::[] -> + let try_unembed e x = + FStar_Syntax_Embeddings_Base.try_unembed e x + FStar_Syntax_Embeddings_Base.id_norm_cb in + let uu___4 = + let uu___5 = + try_unembed FStar_Syntax_Embeddings.e_any ta in + let uu___6 = + try_unembed FStar_Syntax_Embeddings.e_any tb in + let uu___7 = + try_unembed + (FStar_Syntax_Embeddings.e_sealed + FStar_Syntax_Embeddings.e_any) s in + let uu___8 = + try_unembed FStar_Syntax_Embeddings.e_any f in + (uu___5, uu___6, uu___7, uu___8) in + (match uu___4 with + | (FStar_Pervasives_Native.Some ta1, + FStar_Pervasives_Native.Some tb1, + FStar_Pervasives_Native.Some s1, + FStar_Pervasives_Native.Some f1) -> + let r = + let uu___5 = + let uu___6 = + FStar_Syntax_Syntax.as_arg + (FStar_Compiler_Sealed.unseal s1) in + [uu___6] in + FStar_Syntax_Util.mk_app f1 uu___5 in + let uu___5 = + FStar_TypeChecker_Primops_Base.embed_simple + FStar_Syntax_Embeddings.e_any + psc.FStar_TypeChecker_Primops_Base.psc_range r in + FStar_Pervasives_Native.Some uu___5 + | uu___5 -> FStar_Pervasives_Native.None) + | uu___ -> FStar_Pervasives_Native.None)), + ((fun cb -> + fun univs -> + fun args -> + match args with + | (ta, uu___)::(tb, uu___1)::(s, uu___2)::(f, uu___3)::[] -> + let try_unembed e x = + FStar_TypeChecker_NBETerm.unembed e bogus_cbs x in + let uu___4 = + let uu___5 = + try_unembed FStar_TypeChecker_NBETerm.e_any ta in + let uu___6 = + try_unembed FStar_TypeChecker_NBETerm.e_any tb in + let uu___7 = + try_unembed + (FStar_TypeChecker_NBETerm.e_sealed + FStar_TypeChecker_NBETerm.e_any) s in + let uu___8 = + try_unembed FStar_TypeChecker_NBETerm.e_any f in + (uu___5, uu___6, uu___7, uu___8) in + (match uu___4 with + | (FStar_Pervasives_Native.Some ta1, + FStar_Pervasives_Native.Some tb1, + FStar_Pervasives_Native.Some s1, + FStar_Pervasives_Native.Some f1) -> + let r = + let uu___5 = + let uu___6 = + FStar_TypeChecker_NBETerm.as_arg + (FStar_Compiler_Sealed.unseal s1) in + [uu___6] in + cb.FStar_TypeChecker_NBETerm.iapp f1 uu___5 in + let emb = + FStar_TypeChecker_NBETerm.set_type ta1 + FStar_TypeChecker_NBETerm.e_any in + let uu___5 = FStar_TypeChecker_NBETerm.embed emb cb r in + FStar_Pervasives_Native.Some uu___5 + | uu___5 -> FStar_Pervasives_Native.None) + | uu___ -> FStar_Pervasives_Native.None)))] \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml index fdfb141aa1d..57731c0150e 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml @@ -4854,13 +4854,13 @@ let (check_comp : FStar_TypeChecker_Err.computed_computation_type_does_not_match_annotation_eq env e c c' in let uu___5 = FStar_TypeChecker_Env.get_range env in - FStar_Errors.raise_error uu___4 uu___5 + FStar_Errors.raise_error_doc uu___4 uu___5 else (let uu___5 = FStar_TypeChecker_Err.computed_computation_type_does_not_match_annotation env e c c' in let uu___6 = FStar_TypeChecker_Env.get_range env in - FStar_Errors.raise_error uu___5 uu___6) + FStar_Errors.raise_error_doc uu___5 uu___6) | FStar_Pervasives_Native.Some g -> (e, c', g)) let (universe_of_comp : FStar_TypeChecker_Env.env -> From bbc0767286397456dd69b28aadd1222f4fdfd936 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 3 May 2024 08:23:08 -0700 Subject: [PATCH 165/239] Add test for #2172 Keeping open as there is a discrepancy between these two, but at least keep the test in CI so we do not regress. --- tests/bug-reports/Bug2172.fst | 12 ++++++++++++ tests/bug-reports/Makefile | 2 +- 2 files changed, 13 insertions(+), 1 deletion(-) create mode 100644 tests/bug-reports/Bug2172.fst diff --git a/tests/bug-reports/Bug2172.fst b/tests/bug-reports/Bug2172.fst new file mode 100644 index 00000000000..055514abb71 --- /dev/null +++ b/tests/bug-reports/Bug2172.fst @@ -0,0 +1,12 @@ +module Bug2172 + +// one existential quantification over two variables (`p2` below) is +// different from two extistential quantifications over one variable +// each (`p1` below) + +let p1 = exists (x: int). exists (y: int). 0 == x + y +let p2 = exists (x: int) (y: int). 0 == x + y + +let _ = assert p1 +let _ = assert p2 +let _ = assert (p1 <==> p2) diff --git a/tests/bug-reports/Makefile b/tests/bug-reports/Makefile index ce2246e09d5..a3f690fba6f 100644 --- a/tests/bug-reports/Makefile +++ b/tests/bug-reports/Makefile @@ -78,7 +78,7 @@ SHOULD_VERIFY_CLOSED=\ Bug3120a.fst Bug3120b.fst Bug3186.fst Bug3185.fst Bug3210.fst \ Bug3213.fst Bug3213b.fst Bug3207.fst Bug3207b.fst Bug3207c.fst \ Bug2155.fst Bug3224a.fst Bug3224b.fst Bug3236.fst Bug3252.fst \ - BugBoxInjectivity.fst BugTypeParamProjector.fst + BugBoxInjectivity.fst BugTypeParamProjector.fst Bug2172.fst SHOULD_VERIFY_INTERFACE_CLOSED=Bug771.fsti Bug771b.fsti SHOULD_VERIFY_AND_WARN_CLOSED=Bug016.fst From b88f5f0fafb90fc31a907607b6298772bf73346e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 3 May 2024 08:28:19 -0700 Subject: [PATCH 166/239] Rel: fix bad environment Fixes #3266 --- src/typechecker/FStar.TypeChecker.Rel.fst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/typechecker/FStar.TypeChecker.Rel.fst b/src/typechecker/FStar.TypeChecker.Rel.fst index f7c077c19bc..ebd3511bb21 100644 --- a/src/typechecker/FStar.TypeChecker.Rel.fst +++ b/src/typechecker/FStar.TypeChecker.Rel.fst @@ -4194,7 +4194,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = | Some (sub_probs, wl) -> let sc_prob, wl = mk_t_problem wl [] orig s1 EQ s2 None "match scrutinee" in let sub_probs = ([], sc_prob)::sub_probs in - let formula = U.mk_conj_l (List.map (fun (scope, p) -> close_forall wl.tcenv scope (p_guard p)) sub_probs) in + let formula = U.mk_conj_l (List.map (fun (scope, p) -> close_forall (p_env wl orig) scope (p_guard p)) sub_probs) in let tx = UF.new_transaction () in let wl = solve_prob orig (Some formula) [] wl in begin match solve (attempt (List.map snd sub_probs) ({wl with smt_ok = false})) with From 053dbe4fabd71901733cb07979ab2a662ef53d0d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 3 May 2024 08:28:47 -0700 Subject: [PATCH 167/239] snap --- ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml index dca9b326c23..3b92d872542 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml @@ -10635,7 +10635,7 @@ and (solve_t' : tprob -> worklist -> solution) = match uu___14 with | (scope, p) -> FStar_TypeChecker_Env.close_forall - wl2.tcenv scope (p_guard p)) + (p_env wl2 orig) scope (p_guard p)) sub_probs1 in FStar_Syntax_Util.mk_conj_l uu___13 in let tx = FStar_Syntax_Unionfind.new_transaction () in From 955d80f8530282acb61966dbaca771cfafbe8254 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 3 May 2024 08:28:42 -0700 Subject: [PATCH 168/239] Add repro for #3266 --- tests/bug-reports/Bug3266.fst | 22 ++++++++++++++++++++++ tests/bug-reports/Makefile | 2 +- 2 files changed, 23 insertions(+), 1 deletion(-) create mode 100644 tests/bug-reports/Bug3266.fst diff --git a/tests/bug-reports/Bug3266.fst b/tests/bug-reports/Bug3266.fst new file mode 100644 index 00000000000..8427972b7e6 --- /dev/null +++ b/tests/bug-reports/Bug3266.fst @@ -0,0 +1,22 @@ +module Bug3266 + +assume +val s : Type0 +let st (a:Type) : Type = a & s + +let functor_laws + (map : (a:_ -> st a -> unit)) + = unit + +noeq +type functor = { + map : a:Type -> st a -> unit; + laws : functor_laws map; +} + +#set-options "--defensive abort" + +let ff : functor = { + map = (fun a (stf: st a) -> let x, s1 = stf in ()); //if you remove the pattern matching on stf then no error is reported + laws = admit () //if you remove the admit here, again no error +} diff --git a/tests/bug-reports/Makefile b/tests/bug-reports/Makefile index a3f690fba6f..77dd01b9a70 100644 --- a/tests/bug-reports/Makefile +++ b/tests/bug-reports/Makefile @@ -78,7 +78,7 @@ SHOULD_VERIFY_CLOSED=\ Bug3120a.fst Bug3120b.fst Bug3186.fst Bug3185.fst Bug3210.fst \ Bug3213.fst Bug3213b.fst Bug3207.fst Bug3207b.fst Bug3207c.fst \ Bug2155.fst Bug3224a.fst Bug3224b.fst Bug3236.fst Bug3252.fst \ - BugBoxInjectivity.fst BugTypeParamProjector.fst Bug2172.fst + BugBoxInjectivity.fst BugTypeParamProjector.fst Bug2172.fst Bug3266.fst SHOULD_VERIFY_INTERFACE_CLOSED=Bug771.fsti Bug771b.fsti SHOULD_VERIFY_AND_WARN_CLOSED=Bug016.fst From df0bd3aaaf242ad543576d29b8473e23bc4d3478 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 3 May 2024 11:47:56 -0700 Subject: [PATCH 169/239] Improving sligthly the label for assert_spinoff --- src/tactics/FStar.Tactics.Hooks.fst | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/tactics/FStar.Tactics.Hooks.fst b/src/tactics/FStar.Tactics.Hooks.fst index 596acf876e5..249b81cf5a3 100644 --- a/src/tactics/FStar.Tactics.Hooks.fst +++ b/src/tactics/FStar.Tactics.Hooks.fst @@ -142,13 +142,17 @@ let by_tactic_interp (pol:pol) (e:Env.env) (t:term) : tres = begin match pol with | StrictlyPositive | Pos -> - Simplified (FStar.Syntax.Util.t_true, [fst <| goal_of_goal_ty e assertion]) + let g = fst <| goal_of_goal_ty e assertion in + let g = set_label "spun-off assertion" g in + Simplified (FStar.Syntax.Util.t_true, [g]) | Both -> - Dual (assertion, FStar.Syntax.Util.t_true, [fst <| goal_of_goal_ty e assertion]) + let g = fst <| goal_of_goal_ty e assertion in + let g = set_label "spun-off assertion" g in + Dual (assertion, FStar.Syntax.Util.t_true, [g]) | Neg -> - Simplified (assertion, []) + Simplified (assertion, []) end // rewrite_with_tactic marker From 1b90804c1514bcc32a2f6fd148c2617a02f21e38 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 3 May 2024 16:15:46 -0700 Subject: [PATCH 170/239] Syntax.Util: remove commented-out eq_tm --- src/syntax/FStar.Syntax.Util.fst | 268 ------------------------------- 1 file changed, 268 deletions(-) diff --git a/src/syntax/FStar.Syntax.Util.fst b/src/syntax/FStar.Syntax.Util.fst index 58c6469defc..c6a125dbee1 100644 --- a/src/syntax/FStar.Syntax.Util.fst +++ b/src/syntax/FStar.Syntax.Util.fst @@ -500,274 +500,6 @@ let canon_app t = let hd, args = head_and_args_full (unascribe t) in mk_Tm_app hd args t.pos -// (* ---------------------------------------------------------------------- *) -// (* Syntactic equality of terms *) -// (* ---------------------------------------------------------------------- *) -// type eq_result = -// | Equal -// | NotEqual -// | Unknown - -// // Functions that we specially treat as injective, to make normalization -// // (particularly of decidable equality) better. We should make sure they -// // are actually proved to be injective. -// let injectives = -// ["FStar.Int8.int_to_t"; -// "FStar.Int16.int_to_t"; -// "FStar.Int32.int_to_t"; -// "FStar.Int64.int_to_t"; -// "FStar.Int128.int_to_t"; -// "FStar.UInt8.uint_to_t"; -// "FStar.UInt16.uint_to_t"; -// "FStar.UInt32.uint_to_t"; -// "FStar.UInt64.uint_to_t"; -// "FStar.UInt128.uint_to_t"; -// "FStar.SizeT.uint_to_t"; -// "FStar.Int8.__int_to_t"; -// "FStar.Int16.__int_to_t"; -// "FStar.Int32.__int_to_t"; -// "FStar.Int64.__int_to_t"; -// "FStar.Int128.__int_to_t"; -// "FStar.UInt8.__uint_to_t"; -// "FStar.UInt16.__uint_to_t"; -// "FStar.UInt32.__uint_to_t"; -// "FStar.UInt64.__uint_to_t"; -// "FStar.UInt128.__uint_to_t"; -// "FStar.SizeT.__uint_to_t"; -// ] - -// // Compose two eq_result injectively, as in a pair -// let eq_inj r s = -// match r, s with -// | Equal, Equal -> Equal -// | NotEqual, _ -// | _, NotEqual -> NotEqual -// | _, _ -> Unknown - -// // Promote a bool to eq_result, conservatively. -// let equal_if = function -// | true -> Equal -// | _ -> Unknown - -// // Promote a bool to an eq_result, taking a false to bet NotEqual. -// // This is only useful for fully decidable equalities. -// // Use with care, see note about Const_real below and #2806. -// let equal_iff = function -// | true -> Equal -// | _ -> NotEqual - -// // Compose two equality results, NOT assuming a NotEqual implies anything. -// // This is useful, e.g., for checking the equality of applications. Consider -// // f x ~ g y -// // if f=g and x=y then we know these two expressions are equal, but cannot say -// // anything when either result is NotEqual or Unknown, hence this returns Unknown -// // in most cases. -// // The second comparison is thunked for efficiency. -// let eq_and r s = -// if r = Equal && s () = Equal -// then Equal -// else Unknown - -// (* Precondition: terms are well-typed in a common environment, or this can return false positives *) -// let rec eq_tm (t1:term) (t2:term) : eq_result = -// let t1 = canon_app t1 in -// let t2 = canon_app t2 in -// let equal_data (f1:fv) (args1:Syntax.args) (f2:fv) (args2:Syntax.args) = -// // we got constructors! we know they are injective and disjoint, so we can do some -// // good analysis on them -// if fv_eq f1 f2 -// then ( -// assert (List.length args1 = List.length args2); -// List.fold_left (fun acc ((a1, q1), (a2, q2)) -> -// //if q1 <> q2 -// //then failwith (U.format1 "Arguments of %s mismatch on implicit qualifier\n" -// // (Ident.string_of_lid f1.fv_name.v)); -// //NS: 05/06/2018 ...this does not always hold -// // it's been succeeding because the assert is disabled in the non-debug builds -// //assert (q1 = q2); -// eq_inj acc (eq_tm a1 a2)) Equal <| List.zip args1 args2 -// ) else NotEqual -// in -// let qual_is_inj = function -// | Some Data_ctor -// | Some (Record_ctor _) -> true -// | _ -> false -// in -// let heads_and_args_in_case_both_data :option (fv * args * fv * args) = -// let head1, args1 = t1 |> unmeta |> head_and_args in -// let head2, args2 = t2 |> unmeta |> head_and_args in -// match (un_uinst head1).n, (un_uinst head2).n with -// | Tm_fvar f, Tm_fvar g when qual_is_inj f.fv_qual && -// qual_is_inj g.fv_qual -> Some (f, args1, g, args2) -// | _ -> None -// in -// let t1 = unmeta t1 in -// let t2 = unmeta t2 in -// match t1.n, t2.n with -// // We sometimes compare open terms, as we get alpha-equivalence -// // for free. -// | Tm_bvar bv1, Tm_bvar bv2 -> -// equal_if (bv1.index = bv2.index) - -// | Tm_lazy _, _ -> eq_tm (unlazy t1) t2 -// | _, Tm_lazy _ -> eq_tm t1 (unlazy t2) - -// | Tm_name a, Tm_name b -> -// equal_if (bv_eq a b) - -// | _ when heads_and_args_in_case_both_data |> is_some -> //matches only when both are data constructors -// heads_and_args_in_case_both_data |> must |> (fun (f, args1, g, args2) -> -// equal_data f args1 g args2 -// ) - -// | Tm_fvar f, Tm_fvar g -> equal_if (fv_eq f g) - -// | Tm_uinst(f, us), Tm_uinst(g, vs) -> -// // If the fvars and universe instantiations match, then Equal, -// // otherwise Unknown. -// eq_and (eq_tm f g) (fun () -> equal_if (eq_univs_list us vs)) - -// | Tm_constant (Const_range _), Tm_constant (Const_range _) -> -// // Ranges should be opaque, even to the normalizer. c.f. #1312 -// Unknown - -// | Tm_constant (Const_real r1), Tm_constant (Const_real r2) -> -// // We cannot decide equality of reals. Use a conservative approach here. -// // If the strings match, they are equal, otherwise we don't know. If this -// // goes via the eq_iff case below, it will falsely claim that "1.0R" and -// // "01.R" are different, since eq_const does not canonizalize the string -// // representations. -// equal_if (r1 = r2) - -// | Tm_constant c, Tm_constant d -> -// // NOTE: this relies on the fact that eq_const *correctly decides* -// // semantic equality of constants. This needs some care. For instance, -// // since integers are represented by a string, eq_const needs to take care -// // of ignoring leading zeroes, and match 0 with -0. An exception to this -// // are real number literals (handled above). See #2806. -// // -// // Currently (24/Jan/23) this seems to be correctly implemented, but -// // updates should be done with care. -// equal_iff (eq_const c d) - -// | Tm_uvar (u1, ([], _)), Tm_uvar (u2, ([], _)) -> -// equal_if (Unionfind.equiv u1.ctx_uvar_head u2.ctx_uvar_head) - -// | Tm_app {hd=h1; args=args1}, Tm_app {hd=h2; args=args2} -> -// begin match (un_uinst h1).n, (un_uinst h2).n with -// | Tm_fvar f1, Tm_fvar f2 when fv_eq f1 f2 && List.mem (string_of_lid (lid_of_fv f1)) injectives -> -// equal_data f1 args1 f2 args2 - -// | _ -> // can only assert they're equal if they syntactically match, nothing else -// eq_and (eq_tm h1 h2) (fun () -> eq_args args1 args2) -// end - -// | Tm_match {scrutinee=t1; brs=bs1}, Tm_match {scrutinee=t2; brs=bs2} -> //AR: note: no return annotations -// if List.length bs1 = List.length bs2 -// then List.fold_right (fun (b1, b2) a -> eq_and a (fun () -> branch_matches b1 b2)) -// (List.zip bs1 bs2) -// (eq_tm t1 t2) -// else Unknown - -// | Tm_type u, Tm_type v -> -// equal_if (eq_univs u v) - -// | Tm_quoted (t1, q1), Tm_quoted (t2, q2) -> -// // NOTE: we do NOT ever provide a meaningful result for quoted terms. Even -// // if term_eq (the syntactic equality) returns true, that does not mean we -// // can present the equality to userspace since term_eq ignores the names -// // of binders, but the view exposes them. Hence, we simply always return -// // Unknown. We do not seem to rely anywhere on simplifying equalities of -// // quoted literals. See also #2806. -// Unknown - -// | Tm_refine {b=t1; phi=phi1}, Tm_refine {b=t2; phi=phi2} -> -// eq_and (eq_tm t1.sort t2.sort) (fun () -> eq_tm phi1 phi2) - -// (* -// * AR: ignoring residual comp here, that's an ascription added by the typechecker -// * do we care if that's different? -// *) -// | Tm_abs {bs=bs1; body=body1}, Tm_abs {bs=bs2; body=body2} -// when List.length bs1 = List.length bs2 -> - -// eq_and (List.fold_left2 (fun r b1 b2 -> eq_and r (fun () -> eq_tm b1.binder_bv.sort b2.binder_bv.sort)) -// Equal bs1 bs2) -// (fun () -> eq_tm body1 body2) - -// | Tm_arrow {bs=bs1; comp=c1}, Tm_arrow {bs=bs2; comp=c2} -// when List.length bs1 = List.length bs2 -> -// eq_and (List.fold_left2 (fun r b1 b2 -> eq_and r (fun () -> eq_tm b1.binder_bv.sort b2.binder_bv.sort)) -// Equal bs1 bs2) -// (fun () -> eq_comp c1 c2) - -// | _ -> Unknown - -// and eq_antiquotations a1 a2 = -// // Basically this; -// // List.fold_left2 (fun acc t1 t2 -> eq_inj acc (eq_tm t1 t2)) Equal a1 a2 -// // but lazy and handling lists of different size -// match a1, a2 with -// | [], [] -> Equal -// | [], _ -// | _, [] -> NotEqual -// | t1::a1, t2::a2 -> -// match eq_tm t1 t2 with -// | NotEqual -> NotEqual -// | Unknown -> -// (match eq_antiquotations a1 a2 with -// | NotEqual -> NotEqual -// | _ -> Unknown) -// | Equal -> eq_antiquotations a1 a2 - -// and branch_matches b1 b2 = -// let related_by f o1 o2 = -// match o1, o2 with -// | None, None -> true -// | Some x, Some y -> f x y -// | _, _ -> false -// in -// let (p1, w1, t1) = b1 in -// let (p2, w2, t2) = b2 in -// if eq_pat p1 p2 -// then begin -// // We check the `when` branches too, even if unsupported for now -// if eq_tm t1 t2 = Equal && related_by (fun t1 t2 -> eq_tm t1 t2 = Equal) w1 w2 -// then Equal -// else Unknown -// end -// else Unknown - -// and eq_args (a1:args) (a2:args) : eq_result = -// match a1, a2 with -// | [], [] -> Equal -// | (a, _)::a1, (b, _)::b1 -> -// (match eq_tm a b with -// | Equal -> eq_args a1 b1 -// | _ -> Unknown) -// | _ -> Unknown - -// and eq_univs_list (us:universes) (vs:universes) : bool = -// List.length us = List.length vs -// && List.forall2 eq_univs us vs - -// and eq_comp (c1 c2:comp) : eq_result = -// match c1.n, c2.n with -// | Total t1, Total t2 -// | GTotal t1, GTotal t2 -> -// eq_tm t1 t2 -// | Comp ct1, Comp ct2 -> -// eq_and (equal_if (eq_univs_list ct1.comp_univs ct2.comp_univs)) -// (fun _ -> -// eq_and (equal_if (Ident.lid_equals ct1.effect_name ct2.effect_name)) -// (fun _ -> -// eq_and (eq_tm ct1.result_typ ct2.result_typ) -// (fun _ -> eq_args ct1.effect_args ct2.effect_args))) -// //ignoring cflags -// | _ -> NotEqual - - - let rec unrefine t = let t = compress t in match t.n with From 31f2a78a6e71ed4f342f016627f37f89a3e070a4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 3 May 2024 17:14:49 -0700 Subject: [PATCH 171/239] Options: fix typo --- src/basic/FStar.Options.fst | 4 ++-- src/basic/FStar.Options.fsti | 2 +- src/fstar/FStar.Universal.fst | 2 +- src/typechecker/FStar.TypeChecker.Tc.fst | 4 ++-- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/basic/FStar.Options.fst b/src/basic/FStar.Options.fst index 9fe650ccfaf..77ccef28cf8 100644 --- a/src/basic/FStar.Options.fst +++ b/src/basic/FStar.Options.fst @@ -1239,7 +1239,7 @@ let rec specs_with_types warn_unsafe : list (char * string * opt_type * Pprint.d Const (Bool true), text "Print the time it takes to verify each top-level definition. \ This is just an alias for an invocation of the profiler, so it may not work well if combined with --profile. \ - In particular, it implies --profile_group_by_decls."); + In particular, it implies --profile_group_by_decl."); ( noshort, "trace_error", @@ -1804,7 +1804,7 @@ let codegen () = let codegen_libs () = get_codegen_lib () |> List.map (fun x -> Util.split x ".") -let profile_group_by_decls () = get_profile_group_by_decl () +let profile_group_by_decl () = get_profile_group_by_decl () let defensive () = get_defensive () <> "no" let defensive_error () = get_defensive () = "error" let defensive_abort () = get_defensive () = "abort" diff --git a/src/basic/FStar.Options.fsti b/src/basic/FStar.Options.fsti index 06a503029c7..9168dab155d 100644 --- a/src/basic/FStar.Options.fsti +++ b/src/basic/FStar.Options.fsti @@ -110,7 +110,7 @@ val codegen : unit -> option codegen_t val parse_codegen : string -> option codegen_t val codegen_libs : unit -> list (list string) val profile_enabled : module_name:option string -> profile_phase:string -> bool -val profile_group_by_decls : unit -> bool +val profile_group_by_decl : unit -> bool val defensive : unit -> bool // true if checks should be performed val defensive_error : unit -> bool // true if "error" val defensive_abort : unit -> bool // true if "abort" diff --git a/src/fstar/FStar.Universal.fst b/src/fstar/FStar.Universal.fst index d142b49d7ab..58381412abd 100644 --- a/src/fstar/FStar.Universal.fst +++ b/src/fstar/FStar.Universal.fst @@ -546,7 +546,7 @@ let rec tc_fold_interleave (deps:FStar.Parser.Dep.deps) //used to query parsing | _ -> let mods, mllibs, env_before = acc in let remaining, nmod, mllib, env = tc_one_file_from_remaining remaining env_before deps in - if not (Options.profile_group_by_decls()) + if not (Options.profile_group_by_decl()) then Profiling.report_and_clear (Ident.string_of_lid nmod.checked_module.name); tc_fold_interleave deps (mods@[nmod], mllibs@(as_list env_before mllib), env) remaining diff --git a/src/typechecker/FStar.TypeChecker.Tc.fst b/src/typechecker/FStar.TypeChecker.Tc.fst index 5e1c955edb1..7fbc18077c4 100644 --- a/src/typechecker/FStar.TypeChecker.Tc.fst +++ b/src/typechecker/FStar.TypeChecker.Tc.fst @@ -1063,8 +1063,8 @@ let tc_decls env ses = // ^ See a special case for this phase in FStar.Options. --timing // enables it. in - if Options.profile_group_by_decls() - || Options.timing () // --timing implies --profile_group_by_decls + if Options.profile_group_by_decl() + || Options.timing () // --timing implies --profile_group_by_decl then begin let tag = match lids_of_sigelt se with From bb9e55a2bf04feef4a26b7f8bdc69fc5e595dc57 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 3 May 2024 12:09:38 -0700 Subject: [PATCH 172/239] snap --- ocaml/fstar-lib/generated/FStar_Options.ml | 4 +- .../generated/FStar_Tactics_Hooks.ml | 58 +++++++++---------- .../generated/FStar_TypeChecker_Tc.ml | 2 +- ocaml/fstar-lib/generated/FStar_Universal.ml | 3 +- 4 files changed, 30 insertions(+), 37 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Options.ml b/ocaml/fstar-lib/generated/FStar_Options.ml index f5e3154c97f..9de0d1fb33e 100644 --- a/ocaml/fstar-lib/generated/FStar_Options.ml +++ b/ocaml/fstar-lib/generated/FStar_Options.ml @@ -2572,7 +2572,7 @@ let rec (specs_with_types : let uu___189 = text - "Print the time it takes to verify each top-level definition. This is just an alias for an invocation of the profiler, so it may not work well if combined with --profile. In particular, it implies --profile_group_by_decls." in + "Print the time it takes to verify each top-level definition. This is just an alias for an invocation of the profiler, so it may not work well if combined with --profile. In particular, it implies --profile_group_by_decl." in (FStar_Getopt.noshort, "timing", (Const @@ -3950,7 +3950,7 @@ let (codegen_libs : unit -> Prims.string Prims.list Prims.list) = fun uu___ -> let uu___1 = get_codegen_lib () in FStar_Compiler_List.map (fun x -> FStar_Compiler_Util.split x ".") uu___1 -let (profile_group_by_decls : unit -> Prims.bool) = +let (profile_group_by_decl : unit -> Prims.bool) = fun uu___ -> get_profile_group_by_decl () let (defensive : unit -> Prims.bool) = fun uu___ -> let uu___1 = get_defensive () in uu___1 <> "no" diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml index ef387ec7a04..29feead2a69 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml @@ -168,35 +168,29 @@ let (by_tactic_interp : -> (match pol1 with | StrictlyPositive -> - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - FStar_Tactics_Types.goal_of_goal_ty e assertion in - FStar_Pervasives_Native.fst uu___5 in - [uu___4] in - (FStar_Syntax_Util.t_true, uu___3) in - Simplified uu___2 + let g = + let uu___2 = + FStar_Tactics_Types.goal_of_goal_ty e assertion in + FStar_Pervasives_Native.fst uu___2 in + let g1 = + FStar_Tactics_Types.set_label "spun-off assertion" g in + Simplified (FStar_Syntax_Util.t_true, [g1]) | Pos -> - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - FStar_Tactics_Types.goal_of_goal_ty e assertion in - FStar_Pervasives_Native.fst uu___5 in - [uu___4] in - (FStar_Syntax_Util.t_true, uu___3) in - Simplified uu___2 + let g = + let uu___2 = + FStar_Tactics_Types.goal_of_goal_ty e assertion in + FStar_Pervasives_Native.fst uu___2 in + let g1 = + FStar_Tactics_Types.set_label "spun-off assertion" g in + Simplified (FStar_Syntax_Util.t_true, [g1]) | Both -> - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - FStar_Tactics_Types.goal_of_goal_ty e assertion in - FStar_Pervasives_Native.fst uu___5 in - [uu___4] in - (assertion, FStar_Syntax_Util.t_true, uu___3) in - Dual uu___2 + let g = + let uu___2 = + FStar_Tactics_Types.goal_of_goal_ty e assertion in + FStar_Pervasives_Native.fst uu___2 in + let g1 = + FStar_Tactics_Types.set_label "spun-off assertion" g in + Dual (assertion, FStar_Syntax_Util.t_true, [g1]) | Neg -> Simplified (assertion, [])) | (FStar_Syntax_Syntax.Tm_fvar fv, (tactic, FStar_Pervasives_Native.None)::(typ, @@ -1752,7 +1746,7 @@ let (handle_smt_goal : uu___6) gs1) in gs | FStar_Pervasives_Native.None -> [(env, goal1)]) -let (uu___838 : +let (uu___842 : FStar_Syntax_Syntax.term FStar_Syntax_Embeddings_Base.embedding) = FStar_Reflection_V2_Embeddings.e_term type blob_t = @@ -1858,7 +1852,7 @@ let (splice : (FStar_Syntax_Embeddings.e_tuple2 FStar_Reflection_V2_Embeddings.e_env (FStar_Syntax_Embeddings.e_option - uu___838)) + uu___842)) ({ FStar_TypeChecker_Env.solver = (env.FStar_TypeChecker_Env.solver); @@ -1990,14 +1984,14 @@ let (splice : (FStar_Syntax_Embeddings.e_option (FStar_Syntax_Embeddings.e_tuple2 FStar_Syntax_Embeddings.e_string - uu___838)))) + uu___842)))) (FStar_Syntax_Embeddings.e_tuple3 FStar_Syntax_Embeddings.e_bool FStar_Reflection_V2_Embeddings.e_sigelt (FStar_Syntax_Embeddings.e_option (FStar_Syntax_Embeddings.e_tuple2 FStar_Syntax_Embeddings.e_string - uu___838))) + uu___842))) (FStar_Syntax_Embeddings.e_list (FStar_Syntax_Embeddings.e_tuple3 FStar_Syntax_Embeddings.e_bool @@ -2005,7 +1999,7 @@ let (splice : (FStar_Syntax_Embeddings.e_option (FStar_Syntax_Embeddings.e_tuple2 FStar_Syntax_Embeddings.e_string - uu___838))))) tau1 + uu___842))))) tau1 tactic_already_typed ps in match uu___7 with | (gs, diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml index 211a4750dfa..139cc8ff795 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml @@ -4800,7 +4800,7 @@ let (tc_decls : (fun uu___4 -> process_one_decl acc se) uu___3 "FStar.TypeChecker.Tc.process_one_decl" in ((let uu___4 = - (FStar_Options.profile_group_by_decls ()) || + (FStar_Options.profile_group_by_decl ()) || (FStar_Options.timing ()) in if uu___4 then diff --git a/ocaml/fstar-lib/generated/FStar_Universal.ml b/ocaml/fstar-lib/generated/FStar_Universal.ml index 20f5f331cd3..73a13be47a2 100644 --- a/ocaml/fstar-lib/generated/FStar_Universal.ml +++ b/ocaml/fstar-lib/generated/FStar_Universal.ml @@ -1361,8 +1361,7 @@ let rec (tc_fold_interleave : (match uu___2 with | (remaining1, nmod, mllib, env) -> ((let uu___4 = - let uu___5 = - FStar_Options.profile_group_by_decls () in + let uu___5 = FStar_Options.profile_group_by_decl () in Prims.op_Negation uu___5 in if uu___4 then From 782b0fd08db6e5336db8d05f8eb0ecda4f9eb423 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 4 May 2024 13:41:28 -0700 Subject: [PATCH 173/239] Syntax.Print: showable pat and const instances --- src/syntax/FStar.Syntax.Print.fst | 2 ++ src/syntax/FStar.Syntax.Print.fsti | 2 ++ 2 files changed, 4 insertions(+) diff --git a/src/syntax/FStar.Syntax.Print.fst b/src/syntax/FStar.Syntax.Print.fst index bae29bae17f..c205bf7a3f2 100644 --- a/src/syntax/FStar.Syntax.Print.fst +++ b/src/syntax/FStar.Syntax.Print.fst @@ -1010,6 +1010,8 @@ instance showable_pragma = { show = pragma_to_string; } instance showable_subst_elt = { show = subst_elt_to_string; } instance showable_branch = { show = branch_to_string; } instance showable_qualifier = { show = qual_to_string; } +instance showable_pat = { show = pat_to_string; } +instance showable_const = { show = const_to_string; } instance pretty_term = { pp = term_to_doc; } instance pretty_univ = { pp = univ_to_doc; } diff --git a/src/syntax/FStar.Syntax.Print.fsti b/src/syntax/FStar.Syntax.Print.fsti index b42e89b7616..0a1d5f0875c 100644 --- a/src/syntax/FStar.Syntax.Print.fsti +++ b/src/syntax/FStar.Syntax.Print.fsti @@ -104,6 +104,8 @@ instance val showable_pragma : showable pragma instance val showable_subst_elt : showable subst_elt instance val showable_branch : showable branch instance val showable_qualifier : showable qualifier +instance val showable_pat : showable pat +instance val showable_const : showable sconst instance val pretty_term : pretty term instance val pretty_univ : pretty universe From c6b2636756a49aa0c4279c6f062b19267e09b2a8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 4 May 2024 13:38:19 -0700 Subject: [PATCH 174/239] TcTerm: use more typeclasses --- src/typechecker/FStar.TypeChecker.TcTerm.fst | 281 ++++++++++--------- 1 file changed, 144 insertions(+), 137 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.TcTerm.fst b/src/typechecker/FStar.TypeChecker.TcTerm.fst index 17b1f78a3e2..3dfd176e4bd 100644 --- a/src/typechecker/FStar.TypeChecker.TcTerm.fst +++ b/src/typechecker/FStar.TypeChecker.TcTerm.fst @@ -86,12 +86,12 @@ let check_no_escape (head_opt : option term) let msg = match head_opt with | None -> [ - text "Bound variable" ^/^ squotes (doc_of_string (Print.bv_to_string x)) + text "Bound variable" ^/^ squotes (doc_of_string (show x)) ^/^ text "would escape in the type of this letbinding"; text "Add a type annotation that does not mention it"; ] | Some head -> [ - text "Bound variable" ^/^ squotes (doc_of_string (Print.bv_to_string x)) + text "Bound variable" ^/^ squotes (doc_of_string (show x)) ^/^ text "escapes because of impure applications in the type of" ^/^ squotes (N.term_to_doc env head); text "Add explicit let-bindings to avoid this"; @@ -252,7 +252,7 @@ let value_check_expected_typ env (e:term) (tlc:either term lcomp) (guard:guard_t let e, lc, g = TcUtil.check_has_type_maybe_coerce env e lc t' use_eq in if Debug.medium () then BU.print4 "value_check_expected_typ: type is %s<:%s \tguard is %s, %s\n" - (TcComm.lcomp_to_string lc) (Print.term_to_string t') + (TcComm.lcomp_to_string lc) (show t') (Rel.guard_to_string env g) (Rel.guard_to_string env guard); let t = lc.res_typ in let g = Env.conj_guard g guard in @@ -363,9 +363,9 @@ let check_expected_effect env (use_eq:bool) (copt:option comp) (ec : term * comp def_check_scoped c.pos "check_expected_effect.c.after_assume" env c; if Debug.medium () then BU.print4 "In check_expected_effect, asking rel to solve the problem on e=(%s) and c=(%s), expected_c=(%s), and use_eq=%s\n" - (Print.term_to_string e) - (Print.comp_to_string c) - (Print.comp_to_string expected_c) + (show e) + (show c) + (show expected_c) (string_of_bool use_eq); let e, _, g = TcUtil.check_comp env use_eq e c expected_c in let g = TcUtil.label_guard (Env.get_range env) (Errors.mkmsg "Could not prove post-condition") g in @@ -387,7 +387,7 @@ let print_expected_ty_str env = | Some (t, use_eq) -> BU.format2 "Expected type is (%s, use_eq = %s)" - (Print.term_to_string t) + (show t) (string_of_bool use_eq) @@ -436,7 +436,7 @@ let check_pat_fvs rng env pats bs = | Some ({binder_bv=x}) -> Errors.log_issue rng (Errors.Warning_SMTPatternIllFormed, - (BU.format1 "Pattern misses at least one bound variable: %s" (Print.bv_to_string x))) + (BU.format1 "Pattern misses at least one bound variable: %s" (show x))) end (* @@ -483,11 +483,14 @@ let check_no_smt_theory_symbols (en:env) (t:term) :unit = let tlist = t |> pat_terms |> List.collect aux in if List.length tlist = 0 then () //did not find any offending term else + let open FStar.Pprint in + let open FStar.Class.PP in //string to be displayed in the warning - let msg = List.fold_left (fun s t -> s ^ " " ^ (Print.term_to_string t)) "" tlist in - Errors.log_issue t.pos (Errors.Warning_SMTPatternIllFormed, - BU.format1 "Pattern uses these theory symbols or terms that should not be in an smt pattern: %s" - msg) + Errors.log_issue_doc t.pos (Errors.Warning_SMTPatternIllFormed, [ + prefix 2 1 + (text "Pattern uses these theory symbols or terms that should not be in an SMT pattern:") + (group <| separate_map (comma ^^ break_ 1) pp tlist) + ]) let check_smt_pat env t bs c = if U.is_smt_lemma t //check patterns cover the bound vars @@ -511,7 +514,7 @@ let guard_letrecs env actuals expected_c : list (lbname*typ*univ_names) = let decreases_clause bs c = if Debug.low () then BU.print2 "Building a decreases clause over (%s) and %s\n" - (Print.binders_to_string ", " bs) (Print.comp_to_string c); + (Print.binders_to_string ", " bs) (show c); //exclude types and function-typed arguments from the decreases clause //and reveal and erased arguments @@ -586,12 +589,12 @@ let guard_letrecs env actuals expected_c : list (lbname*typ*univ_names) = | _, _ -> Errors.log_issue_doc e1.pos (Errors.Warning_Defensive, [ Errors.Msg.text <| BU.format6 "SMT may not be able to prove the types of %s at %s (%s) and %s at %s (%s) to be equal, if the proof fails, try annotating these with the same type" - (Print.term_to_string e1) + (show e1) (Range.string_of_range e1.pos) - (Print.term_to_string t1) - (Print.term_to_string e2) + (show t1) + (show e2) (Range.string_of_range e2.pos) - (Print.term_to_string t2)])); + (show t2)])); t1, t2 in match l, l_prev with @@ -681,7 +684,7 @@ let guard_letrecs env actuals expected_c : list (lbname*typ*univ_names) = let t' = U.arrow refined_formals c in if Debug.medium () then BU.print3 "Refined let rec %s\n\tfrom type %s\n\tto type %s\n" - (Print.lbname_to_string l) (Print.term_to_string t) (Print.term_to_string t'); + (show l) (show t) (show t'); l, t', u_names in letrecs |> List.map guard_one_letrec @@ -724,7 +727,7 @@ let rec tc_term env e = BU.print5 "(%s) Starting tc_term (phase1=%s) of %s (%s), %s {\n" (Range.string_of_range <| Env.get_range env) (string_of_bool env.phase1) - (Print.term_to_string e) + (show e) (Print.tag_of_term (SS.compress e)) (print_expected_ty_str env); @@ -732,12 +735,12 @@ let rec tc_term env e = tc_maybe_toplevel_term ({env with top_level=false}) e) in if Debug.medium () then begin BU.print4 "(%s) } tc_term of %s (%s) took %sms\n" (Range.string_of_range <| Env.get_range env) - (Print.term_to_string e) + (show e) (Print.tag_of_term (SS.compress e)) (string_of_int ms); let e, lc , _ = r in BU.print4 "(%s) Result is: (%s:%s) (%s)\n" (Range.string_of_range <| Env.get_range env) - (Print.term_to_string e) + (show e) (TcComm.lcomp_to_string lc) (Print.tag_of_term (SS.compress e)) end; @@ -947,14 +950,14 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked if Debug.extreme () then BU.print1 "Typechecking ascribed reflect, inner ascribed term: %s\n" - (Print.term_to_string e); + (show e); let e, _, g_e = tc_tot_or_gtot_term env0 e in let e = U.unascribe e in if Debug.extreme () then BU.print2 "Typechecking ascribed reflect, after typechecking inner ascribed term: %s and guard: %s\n" - (Print.term_to_string e) (Rel.guard_to_string env0 g_e); + (show e) (Rel.guard_to_string env0 g_e); //reconstruct (M.reflect e) < M a is let top = @@ -1032,7 +1035,7 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked | Tm_app {hd={n=Tm_constant Const_range_of}} | Tm_app {hd={n=Tm_constant Const_set_range_of}} -> - raise_error (Errors.Fatal_IllAppliedConstant, BU.format1 "Ill-applied constant %s" (Print.term_to_string top)) e.pos + raise_error (Errors.Fatal_IllAppliedConstant, BU.format1 "Ill-applied constant %s" (show top)) e.pos | Tm_app {hd={n=Tm_constant (Const_reify _)}; args=[(e, aqual)]} -> if Option.isSome aqual @@ -1112,7 +1115,7 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked raise_error (Errors.Fatal_UnexpectedEffect, BU.format3 "Expected repr type for %s is not an application node (%s:%s)" (Ident.string_of_lid l) (Print.tag_of_term expected_repr_typ) - (Print.term_to_string expected_repr_typ)) top.pos in + (show expected_repr_typ)) top.pos in let c = S.mk_Comp ({ comp_univs=[u_a]; @@ -1218,9 +1221,9 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked if !dbg_RFD then ( BU.print3 "Got lc.res_typ=%s; t0 = %s; thead = %s\n" - (Print.term_to_string lc.res_typ) - (Print.term_to_string t0) - (Print.term_to_string thead) + (show lc.res_typ) + (show t0) + (show thead) ); match (SS.compress (U.un_uinst thead)).n with | Tm_fvar type_name -> ( @@ -1282,7 +1285,7 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked if Debug.high () then BU.print3 "(%s) Checking app %s, %s\n" (Range.string_of_range top.pos) - (Print.term_to_string top) + (show top) (print_expected_ty_str env0); //Don't instantiate head; instantiations will be computed below, accounting for implicits/explicits @@ -1316,7 +1319,7 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked let gres = Env.conj_guard gres implicits in if Debug.extreme () then BU.print2 "Guard from application node %s is %s\n" - (Print.term_to_string e) + (show e) (Rel.guard_to_string env gres); e, c, gres @@ -1434,7 +1437,7 @@ and tc_match (env : Env.env) (top : term) : term * lcomp * guard_t = BU.format2 "For a match with returns annotation, the scrutinee should be pure/ghost, \ found %s with effect %s" - (Print.term_to_string e1) + (show e1) (string_of_lid c1.eff_name)) e1.pos; //Clear the expected type in the environment for the branches @@ -1633,7 +1636,7 @@ and tc_synth head env args rng = (Errors.Fatal_NotSupported, BU.format1 "Equality ascription in synth (%s) is not yet supported, \ please use subtyping" - (Print.term_to_string t)) t.pos; + (show t)) t.pos; t | None -> raise_error (Errors.Fatal_SynthByTacticError, "synth_by_tactic: need a type annotation when no expected type is present") (Env.get_range env) end @@ -1649,7 +1652,7 @@ and tc_synth head env args rng = let t = env.synth_hook env typ ({ tau with pos = rng }) in if !dbg_Tac then - BU.print1 "Got %s\n" (Print.term_to_string t); + BU.print1 "Got %s\n" (show t); // Should never trigger, meta-F* will check it before. TcUtil.check_uvars tau.pos t; @@ -1677,7 +1680,7 @@ and check_instantiated_fvar (env:Env.env) (v:S.var) (q:option S.fv_qual) (e:term let t = U.remove_inacc t0 in let e, t, implicits = TcUtil.maybe_instantiate env e t in -// BU.print3 "Instantiated type of %s from %s to %s\n" (Print.term_to_string e) (Print.term_to_string t0) (Print.term_to_string t); +// BU.print3 "Instantiated type of %s from %s to %s\n" (show e) (show t0) (show t); let tc = if Env.should_verify env then Inl t @@ -1702,7 +1705,7 @@ and tc_value env (e:term) : term | Tm_bvar x -> (* This can happen if user tactics build an ill-scoped term *) raise_error (Errors.Error_IllScopedTerm, - BU.format1 "Violation of locally nameless convention: %s" (Print.term_to_string top)) + BU.format1 "Violation of locally nameless convention: %s" (show top)) top.pos | Tm_uvar (u, s) -> //the type of a uvar is given directly with it; we do not recheck the type @@ -1724,7 +1727,7 @@ and tc_value env (e:term) : term (Errors.Fatal_NotSupported, BU.format1 "Equality ascription as an expected type for unk (:%s) is not yet supported, \ please use subtyping" - (Print.term_to_string t)) e.pos; + (show t)) e.pos; t, [], Env.trivial_guard in let e, _, g1 = TcUtil.new_implicit_var @@ -1753,7 +1756,7 @@ and tc_value env (e:term) : term if List.length us <> List.length us' then raise_error (Errors.Fatal_UnexpectedNumberOfUniverse, BU.format3 "Unexpected number of universe instantiations for \"%s\" (%s vs %s)" - (Print.fv_to_string fv) + (show fv) (string_of_int (List.length us)) (string_of_int (List.length us'))) (Env.get_range env); @@ -1770,9 +1773,9 @@ and tc_value env (e:term) : term | _ -> raise_error (Errors.Fatal_IncompatibleUniverse, BU.format3 "Incompatible universe application for %s, expected %s got %s\n" - (Print.fv_to_string fv) - (Print.univ_to_string ul) - (Print.univ_to_string ur)) + (show fv) + (show ul) + (show ur)) (Env.get_range env)) us' us; @@ -1792,11 +1795,11 @@ and tc_value env (e:term) : term maybe_warn_on_use env fv; if !dbg_Range then BU.print5 "Lookup up fvar %s at location %s (lid range = defined at %s, used at %s); got universes type %s\n" - (Print.lid_to_string (lid_of_fv fv)) + (show (lid_of_fv fv)) (Range.string_of_range e.pos) (Range.string_of_range range) (Range.string_of_use_range range) - (Print.term_to_string t); + (show t); Env.insert_fv_info env fv t; let e = S.mk_Tm_uinst (mk (Tm_fvar fv) e.pos) us in check_instantiated_fvar env fv.fv_name fv.fv_qual e t @@ -1839,7 +1842,7 @@ and tc_value env (e:term) : term let x, env, f1, u = tc_binder env (List.hd x) in if Debug.high () then BU.print3 "(%s) Checking refinement formula %s; binder is %s\n" - (Range.string_of_range top.pos) (Print.term_to_string phi) (Print.bv_to_string x.binder_bv); + (Range.string_of_range top.pos) (show phi) (show x.binder_bv); let t_phi, _ = U.type_u () in let phi, _, f2 = tc_check_tot_or_gtot_term env phi t_phi "refinement formula must be pure or ghost" in @@ -1853,12 +1856,12 @@ and tc_value env (e:term) : term (* in case we use type variables which are implicitly quantified, we add quantifiers here *) let bs = TcUtil.maybe_add_implicit_binders env bs in if Debug.medium () - then BU.print1 "Abstraction is: %s\n" (Print.term_to_string ({top with n=Tm_abs {bs; body; rc_opt=None}})); + then BU.print1 "Abstraction is: %s\n" (show ({top with n=Tm_abs {bs; body; rc_opt=None}})); let bs, body = SS.open_term bs body in tc_abs env top bs body | _ -> - failwith (BU.format2 "Unexpected value: %s (%s)" (Print.term_to_string top) (Print.tag_of_term top)) + failwith (BU.format2 "Unexpected value: %s (%s)" (show top) (Print.tag_of_term top)) and tc_constant (env:env_t) r (c:sconst) : typ = let res = @@ -1992,7 +1995,7 @@ and tc_universe env u : universe = | U_name x -> if Env.lookup_univ env x then u - else failwith ("Universe variable " ^ (Print.univ_to_string u) ^ " not found") + else failwith ("Universe variable " ^ (show u) ^ " not found") in if env.lax_universes then U_zero else (match u with | U_unknown -> U.type_u () |> snd @@ -2094,7 +2097,7 @@ and tc_abs_expected_function_typ env (bs:binders) (t0:option (typ * bool)) (body let envbody, letrec_binders, g = letrecs |> List.fold_left (fun (env, letrec_binders, g) (l,t,u_names) -> //let t = N.normalize [Env.EraseUniverses; Env.Beta] env t in - //printfn "Checking let rec annot: %s\n" (Print.term_to_string t); + //printfn "Checking let rec annot: %s\n" (show t); let t, _, g' = tc_term (Env.clear_expected_typ env |> fst) t in let env = Env.push_let_binding env l (u_names, t) in let lb = match l with @@ -2166,7 +2169,7 @@ and tc_abs_check_binders env bs bs_expected use_eq if not (special imp imp') && not (U.eq_bqual imp imp') then raise_error (Errors.Fatal_InconsistentImplicitArgumentAnnotation, - BU.format1 "Inconsistent implicit argument annotation on argument %s" (Print.bv_to_string hd)) + BU.format1 "Inconsistent implicit argument annotation on argument %s" (show hd)) (S.range_of_bv hd) end; @@ -2184,7 +2187,7 @@ and tc_abs_check_binders env bs bs_expected use_eq BU.format3 "Inconsistent positivity qualifier on argument %s; \ Expected qualifier %s, \ found qualifier %s" - (Print.bv_to_string hd) + (show hd) (positivity_qual_to_string pqual_expected) (positivity_qual_to_string pqual_actual)) (S.range_of_bv hd); @@ -2199,7 +2202,7 @@ and tc_abs_check_binders env bs bs_expected use_eq * 2) add an extra guard that the two types must be equal (use_eq will be used in Rel.teq *) | _ -> - if Debug.high () then BU.print1 "Checking binder %s\n" (Print.bv_to_string hd); + if Debug.high () then BU.print1 "Checking binder %s\n" (show hd); let t, _, g1_env = tc_tot_or_gtot_term env hd.sort in let g2_env = let label_guard g = @@ -2262,7 +2265,7 @@ and tc_abs env (top:term) (bs:binders) (body:term) : term * lcomp * guard_t = then BU.print2 "!!!!!!!!!!!!!!!Expected type is (%s), top_level=%s\n" (match topt with | None -> "None" - | Some (t, use_eq) -> Print.term_to_string t ^ ", use_eq = " ^ string_of_bool use_eq) + | Some (t, use_eq) -> show t ^ ", use_eq = " ^ string_of_bool use_eq) (show env.top_level); let tfun_opt, bs, letrec_binders, c_opt, envbody, body, g_env = @@ -2272,13 +2275,13 @@ and tc_abs env (top:term) (bs:binders) (body:term) : term * lcomp * guard_t = then BU.print3 "After expected_function_typ, tfun_opt: %s, c_opt: %s, and expected type in envbody: %s\n" (match tfun_opt with | None -> "None" - | Some t -> Print.term_to_string t) + | Some t -> show t) (match c_opt with | None -> "None" - | Some t -> Print.comp_to_string t) + | Some t -> show t) (match Env.expected_typ envbody with | None -> "None" - | Some (t, use_eq) -> Print.term_to_string t ^ ", use_eq = " ^ string_of_bool use_eq); + | Some (t, use_eq) -> show t ^ ", use_eq = " ^ string_of_bool use_eq); if !dbg_NYC then BU.print2 "!!!!!!!!!!!!!!!Guard for function with binders %s is %s\n" @@ -2395,14 +2398,14 @@ and tc_abs env (top:term) (bs:binders) (body:term) : term * lcomp * guard_t = && not (Positivity.name_unused_in_type envbody b.binder_bv body) then raise_error (Error_InductiveTypeNotSatisfyPositivityCondition, BU.format1 "Binder %s is marked unused, but its use in the definition is not" - (Print.binder_to_string b)) + (show b)) (S.range_of_bv b.binder_bv); if U.is_binder_strictly_positive b && not (Positivity.name_strictly_positive_in_type envbody b.binder_bv body) then raise_error (Error_InductiveTypeNotSatisfyPositivityCondition, BU.format1 "Binder %s is marked strictly positive, but its use in the definition is not" - (Print.binder_to_string b)) + (show b)) (S.range_of_bv b.binder_bv) )) bs @@ -2508,7 +2511,7 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term if Debug.medium () then BU.print1 "\t Type of result cres is %s\n" - (Print.comp_to_string cres); + (show cres); let chead, cres = SS.subst_comp subst chead |> TcComm.lcomp_of_comp, SS.subst_comp subst cres |> TcComm.lcomp_of_comp in @@ -2554,9 +2557,9 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term if TcComm.is_pure_or_ghost_lcomp cres && (head_is_pure_and_some_arg_is_effectful) // || Option.isSome (Env.expected_typ env)) - then let _ = if Debug.extreme () then BU.print1 "(a) Monadic app: Return inserted in monadic application: %s\n" (Print.term_to_string term) in + then let _ = if Debug.extreme () then BU.print1 "(a) Monadic app: Return inserted in monadic application: %s\n" (show term) in TcUtil.maybe_assume_result_eq_pure_term env term cres, true - else let _ = if Debug.extreme () then BU.print1 "(a) Monadic app: No return inserted in monadic application: %s\n" (Print.term_to_string term) in + else let _ = if Debug.extreme () then BU.print1 "(a) Monadic app: No return inserted in monadic application: %s\n" (show term) in cres, false in @@ -2605,8 +2608,8 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term if Debug.extreme () then BU.print3 "(b) Monadic app: Binding argument %s : %s of type (%s)\n" (match x with | None -> "_" - | Some x -> Print.bv_to_string x) - (Print.term_to_string e) + | Some x -> show x) + (show e) (TcComm.lcomp_to_string c); // //Push first (List.length arg_rets_names_opt - i) names in the env @@ -2632,7 +2635,7 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term if Debug.extreme () then BU.print2 "(c) Monadic app: Binding head %s, chead: %s\n" - (Print.term_to_string head) + (show head) (TcComm.lcomp_to_string chead); if TcComm.is_pure_or_ghost_lcomp chead then TcUtil.bind head.pos env (Some head) chead (None, comp) @@ -2667,7 +2670,7 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term let lifted_args, head, args = let map_fun ((e, q), _ , c) = if Debug.extreme () then - BU.print2 "For arg e=(%s) c=(%s)... " (Print.term_to_string e) (TcComm.lcomp_to_string c); + BU.print2 "For arg e=(%s) c=(%s)... " (show e) (TcComm.lcomp_to_string c); if TcComm.is_pure_or_ghost_lcomp c then begin if Debug.extreme () then @@ -2835,8 +2838,8 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term if Debug.high () then BU.print4 "Checking arg (%s) %s at type %s with use_eq:%s\n" (Print.tag_of_term e) - (Print.term_to_string e) - (Print.term_to_string targ) + (show e) + (show targ) (bqual |> is_eq |> string_of_bool); let e, c, g_e = tc_term env e in let g = Env.conj_guard g_ex <| Env.conj_guard g g_e in @@ -2911,9 +2914,9 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term let bs_cres = U.arrow bs cres in if Debug.extreme () then BU.print3 "Forcing the type of %s from %s to %s\n" - (Print.term_to_string head) - (Print.term_to_string tf) - (Print.term_to_string bs_cres); + (show head) + (show tf) + (show bs_cres); //Yes, force only the guard for this equation; the other uvars will not be solved yet let g = Rel.solve_deferred_constraints env (Rel.teq env tf bs_cres) in check_function_app bs_cres (Env.conj_guard g guard) @@ -2923,10 +2926,10 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term let head_info = head, chead, ghead, c in if Debug.extreme () then BU.print4 "######tc_args of head %s @ %s with formals=%s and result type=%s\n" - (Print.term_to_string head) - (Print.term_to_string tf) + (show head) + (show tf) (Print.binders_to_string ", " bs) - (Print.comp_to_string c); + (show c); tc_args head_info ([], [], [], guard, []) bs args | Tm_refine {b=bv} -> @@ -3024,16 +3027,20 @@ and tc_pat env (pat_t:typ) (p0:pat) : let pat_typ_ok env pat_t scrutinee_t : guard_t = if !dbg_Patterns then BU.print2 "$$$$$$$$$$$$pat_typ_ok? %s vs. %s\n" - (Print.term_to_string pat_t) - (Print.term_to_string scrutinee_t); + (show pat_t) (show scrutinee_t); + def_check_scoped pat_t.pos "pat_typ_ok.pat_t.entry" env pat_t; let fail : string -> 'a = fun msg_str -> let msg = if msg_str = "" then [] else [Errors.text msg_str] in let msg = - (Errors.text (BU.format2 "Type of pattern (%s) does not match type of scrutinee (%s)" - (Print.term_to_string pat_t) - (Print.term_to_string scrutinee_t))) :: msg + let open FStar.Pprint in + let open FStar.Class.PP in + let open FStar.Errors.Msg in + ( + prefix 2 1 (text "Type of pattern") (pp pat_t) ^/^ + prefix 2 1 (text "does not match type of scrutinee") (pp scrutinee_t) + ) :: msg in raise_error_doc (Errors.Fatal_MismatchedPatternType, msg) p0.p in @@ -3066,8 +3073,8 @@ and tc_pat env (pat_t:typ) (p0:pat) : match Rel.teq_nosmt env p s with | None -> fail (BU.format2 "Parameter %s <> Parameter %s" - (Print.term_to_string p) - (Print.term_to_string s)) + (show p) + (show s)) | Some g -> let g = Rel.discharge_guard_no_smt env g in Env.conj_guard g out) @@ -3077,8 +3084,8 @@ and tc_pat env (pat_t:typ) (p0:pat) : | _ -> fail "Pattern matching a non-inductive type" else fail (BU.format2 "Head mismatch %s vs %s" - (Print.term_to_string head_p) - (Print.term_to_string head_s)) + (show head_p) + (show head_s)) | _ -> match Rel.teq_nosmt env pat_t scrutinee_t with @@ -3206,7 +3213,7 @@ and tc_pat env (pat_t:typ) (p0:pat) : * guard_t * bool = if !dbg_Patterns - then BU.print2 "Checking pattern %s at type %s\n" (Print.pat_to_string p) (Print.term_to_string t); + then BU.print2 "Checking pattern %s at type %s\n" (show p) (show t); let id t = mk_Tm_app (S.fvar Const.id_lid None) @@ -3250,7 +3257,7 @@ and tc_pat env (pat_t:typ) (p0:pat) : match p.v with | Pat_dot_term _ -> - failwith (BU.format1 "Impossible: Expected an undecorated pattern, got %s" (Print.pat_to_string p)) + failwith (BU.format1 "Impossible: Expected an undecorated pattern, got %s" (show p)) | Pat_var x -> let x = {x with sort=t} in @@ -3272,15 +3279,15 @@ and tc_pat env (pat_t:typ) (p0:pat) : | _ -> fail (BU.format1 "Pattern matching a constant that does not have decidable equality: %s" - (Print.const_to_string c))); + (show c))); let _, e_c, _, _ = PatternUtils.pat_as_exp false false env p in let e_c, lc, g = tc_tot_or_gtot_term env e_c in Rel.force_trivial_guard env g; let expected_t = expected_pat_typ env p0.p t in if not (Rel.teq_nosmt_force env lc.res_typ expected_t) then fail (BU.format2 "Type of pattern (%s) does not match type of scrutinee (%s)" - (Print.term_to_string lc.res_typ) - (Print.term_to_string expected_t)); + (show lc.res_typ) + (show expected_t)); [], [], e_c, @@ -3330,7 +3337,7 @@ and tc_pat env (pat_t:typ) (p0:pat) : if List.length simple_bvs_pat <> List.length sub_pats then failwith (BU.format4 "(%s) Impossible: pattern bvar mismatch: %s; expected %s sub pats; got %s" (Range.string_of_range p.p) - (Print.pat_to_string simple_pat) + (show simple_pat) (BU.string_of_int (List.length sub_pats)) (BU.string_of_int (List.length simple_bvs_pat))); let simple_pat_e, simple_bvs, g1, erasable = @@ -3384,9 +3391,9 @@ and tc_pat env (pat_t:typ) (p0:pat) : let guard = Env.conj_guard guard g' in if !dbg_Patterns then BU.print3 "$$$$$$$$$$$$Checked simple pattern %s at type %s with bvs=%s\n" - (Print.term_to_string simple_pat_e) - (Print.term_to_string simple_pat_t) - (List.map (fun x -> "(" ^ Print.bv_to_string x ^ " : " ^ Print.term_to_string x.sort ^ ")") simple_bvs + (show simple_pat_e) + (show simple_pat_t) + (List.map (fun x -> "(" ^ show x ^ " : " ^ show x.sort ^ ")") simple_bvs |> String.concat " "); simple_pat_e, simple_bvs, guard, erasable in @@ -3452,7 +3459,7 @@ and tc_pat env (pat_t:typ) (p0:pat) : erasable in if !dbg_Patterns - then BU.print1 "Checking pattern: %s\n" (Print.pat_to_string p0); + then BU.print1 "Checking pattern: %s\n" (show p0); let bvs, tms, pat_e, pat, g, erasable = check_nested_pattern (Env.clear_expected_typ env |> fst) @@ -3463,8 +3470,8 @@ and tc_pat env (pat_t:typ) (p0:pat) : let pat_e_norm = N.normalize [Env.Beta] extended_env pat_e in if !dbg_Patterns then BU.print2 "Done checking pattern %s as expression %s\n" - (Print.pat_to_string pat) - (Print.term_to_string pat_e); + (show pat) + (show pat_e); pat, bvs, tms, extended_env, pat_e, pat_e_norm, g, erasable @@ -3510,9 +3517,9 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti in if Debug.extreme () then - BU.print3 "tc_eqn: typechecked pattern %s with bvs %s and pat_bv_tms %s\n" - (Print.pat_to_string pattern) (Print.bvs_to_string ";" pat_bvs) - (List.fold_left (fun s t -> s ^ ";" ^ (Print.term_to_string t)) "" pat_bv_tms); + BU.print3 "tc_eqn: typechecked pattern %s with bvs %s and pat_bv_tms=%s\n" + (show pattern) (Print.bvs_to_string ";" pat_bvs) + (show pat_bv_tms); (* 2. Check the when clause *) let when_clause, g_when = match when_clause with @@ -3601,7 +3608,7 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti let fail () = failwith (BU.format3 "tc_eqn: Impossible (%s) %s (%s)" (Range.string_of_range pat_exp.pos) - (Print.term_to_string pat_exp) + (show pat_exp) (Print.tag_of_term pat_exp)) in let rec head_constructor t = match t.n with @@ -3613,7 +3620,7 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti match scrutinee_tm with | None -> failwith (BU.format2 "Impossible (%s): scrutinee of match is not defined %s" (Range.string_of_range pattern.p) - (Print.pat_to_string pattern)) + (show pattern)) | Some t -> t in let pat_exp = SS.compress pat_exp |> U.unmeta in @@ -3672,8 +3679,8 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti //a non-pattern sub-term computed via unification; no guard needeed since it is from a dot pattern | _ -> failwith (BU.format2 "Internal error: unexpected elaborated pattern: %s and pattern expression %s" - (Print.pat_to_string pattern) - (Print.term_to_string pat_exp)) + (show pattern) + (show pat_exp)) in (* 5 (b) *) @@ -3699,7 +3706,7 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti in if Debug.extreme () then - BU.print1 "tc_eqn: branch guard : %s\n" (Print.term_to_string branch_guard); + BU.print1 "tc_eqn: branch guard : %s\n" (show branch_guard); (* 6 (a). Build equality conditions between the pattern and the scrutinee *) (* (b). Weaken the VCs of the branch and when clause with the equalities from 6 (a) and the when condition *) @@ -3831,9 +3838,9 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti let _ = if !dbg_LayeredEffects - then BU.print2 "tc_eqn: typechecked pat_bv_tms %s (pat_bvs : %s)\n" - (List.fold_left (fun s t -> s ^ ";" ^ (Print.term_to_string t)) "" pat_bv_tms) - (List.fold_left (fun s t -> s ^ ";" ^ (Print.bv_to_string t)) "" pat_bvs) in + then BU.print2 "tc_eqn: typechecked pat_bv_tms=%s (pat_bvs=%s)\n" + (show pat_bv_tms) (show pat_bvs) + in c_weak |> TcComm.apply_lcomp (fun c -> c) (fun g -> match eqs with @@ -3898,7 +3905,7 @@ and check_top_level_let env e = (* Unfold all @tcnorm subterms in the binding *) if Debug.medium () then - BU.print1 "Let binding BEFORE tcnorm: %s\n" (Print.term_to_string e1); + BU.print1 "Let binding BEFORE tcnorm: %s\n" (show e1); let e1 = if Options.tcnorm () then N.normalize [Env.UnfoldAttr [Const.tcnorm_attr]; Env.Exclude Env.Beta; Env.Exclude Env.Zeta; @@ -3906,7 +3913,7 @@ and check_top_level_let env e = else e1 in if Debug.medium () then - BU.print1 "Let binding AFTER tcnorm: %s\n" (Print.term_to_string e1); + BU.print1 "Let binding AFTER tcnorm: %s\n" (show e1); (* * AR: comp for the whole `let x = e1 in e2`, where e2 = () @@ -3972,8 +3979,8 @@ and check_inner_let env e = then raise_error (Errors.Fatal_ExpectedPureExpression, BU.format2 "Definitions marked @inline_let are expected to be pure or ghost; \ got an expression \"%s\" with effect \"%s\"" - (Print.term_to_string e1) - (Print.lid_to_string c1.eff_name)) + (show e1) + (show c1.eff_name)) e1.pos in let x = {BU.left lb.lbname with sort=c1.res_typ} in @@ -4036,15 +4043,15 @@ and check_inner_let env e = then (let tt = Env.expected_typ env |> Option.get |> fst in if !dbg_Exports then BU.print2 "Got expected type from env %s\ncres.res_typ=%s\n" - (Print.term_to_string tt) - (Print.term_to_string cres.res_typ); + (show tt) + (show cres.res_typ); e, cres, guard) else (* no expected type; check that x doesn't escape it's scope *) (let t, g_ex = check_no_escape None env [x] cres.res_typ in if !dbg_Exports then BU.print2 "Checked %s has no escaping types; normalized to %s\n" - (Print.term_to_string cres.res_typ) - (Print.term_to_string t); + (show cres.res_typ) + (show t); e, ({cres with res_typ=t}), Env.conj_guard g_ex guard) | _ -> failwith "Impossible (inner let with more than one lb)" @@ -4230,8 +4237,8 @@ and build_let_rec_env _top_level env lbs : list letbinding * env_t * guard_t = raise_error (Errors.Fatal_RecursiveFunctionLiteral, (BU.format3 "Only function literals with arrow types can be defined recursively; got (%s) %s : %s" (Print.tag_of_term lbdef) - (Print.term_to_string lbdef) - (Print.term_to_string lbtyp))) + (show lbdef) + (show lbtyp))) lbtyp.pos; // TODO: GM: maybe point to the one that's actually empty? let nformals = List.length formals in @@ -4243,7 +4250,7 @@ and build_let_rec_env _top_level env lbs : list letbinding * env_t * guard_t = * totality. Another way of seeing this check is that we take * the minimum amount of binders from the actuals and formals. *) if U.has_attribute attrs Const.admit_termination_lid then ( - log_issue env.range (Warning_WarnOnUse, "Admitting termination of " ^ Print.lbname_to_string lbname); + log_issue env.range (Warning_WarnOnUse, "Admitting termination of " ^ show lbname); None ) else if U.comp_effect_name c |> Env.lookup_effect_quals env |> List.contains TotalEffect then Some (nformals, U.abs actuals body body_lc) @@ -4278,7 +4285,7 @@ and build_let_rec_env _top_level env lbs : list letbinding * env_t * guard_t = | Some (arity, lbdef) -> if Debug.extreme () then BU.print2 "termination_check_enabled returned arity: %s and lbdef: %s\n" - (string_of_int arity) (Print.term_to_string lbdef); + (string_of_int arity) (show lbdef); let lb = {lb with lbtyp=lbtyp; lbunivs=univ_vars; lbdef=lbdef} in let env = {env with letrecs=(lb.lbname, arity, lbtyp, univ_vars)::env.letrecs} in lb, env @@ -4302,8 +4309,8 @@ and check_let_recs env lbts = | [] -> raise_error (Errors.Fatal_RecursiveFunctionLiteral, BU.format2 "Only function literals may be defined recursively; %s is defined to be %s" - (Print.lbname_to_string lb.lbname) - (Print.term_to_string lb.lbdef) + (show lb.lbname) + (show lb.lbdef) ) (S.range_of_lbname lb.lbname) | _ -> (); @@ -4376,7 +4383,7 @@ and check_let_bound_def top_level env lb if Debug.extreme () then BU.print3 "checked let-bound def %s : %s guard is %s\n" - (Print.lbname_to_string lb.lbname) + (show lb.lbname) (TcComm.lcomp_to_string c1) (Rel.guard_to_string env g1); @@ -4413,7 +4420,7 @@ and check_lbtyp top_level env lb : option typ (* checked version of lb.lbtyp, i if Debug.medium () then BU.print2 "(%s) Checked type annotation %s\n" (Range.string_of_range (range_of_lbname lb.lbname)) - (Print.term_to_string t); + (show t); let t = norm env1 t in Some t, g, univ_vars, univ_opening, Env.set_expected_typ env1 t ) @@ -4422,9 +4429,9 @@ and tc_binder env ({binder_bv=x;binder_qual=imp;binder_positivity=pqual;binder_a let tu, u = U.type_u () in if Debug.extreme () then BU.print3 "Checking binder %s:%s at type %s\n" - (Print.bv_to_string x) - (Print.term_to_string x.sort) - (Print.term_to_string tu); + (show x) + (show x.sort) + (show tu); let t, _, g = tc_check_tot_or_gtot_term env x.sort tu "" in //ghost effect ok in the types of binders let imp, g' = match imp with @@ -4438,7 +4445,7 @@ and tc_binder env ({binder_bv=x;binder_qual=imp;binder_positivity=pqual;binder_a check_erasable_binder_attributes env attrs t; let x = S.mk_binder_with_attrs ({x with sort=t}) imp pqual attrs in if Debug.high () - then BU.print2 "Pushing binder %s at type %s\n" (Print.bv_to_string x.binder_bv) (Print.term_to_string t); + then BU.print2 "Pushing binder %s at type %s\n" (show x.binder_bv) (show t); x, push_binding env x, g, u and tc_binders env bs = @@ -4525,7 +4532,7 @@ let tc_check_trivial_guard env t k = in environment env *) let typeof_tot_or_gtot_term env e must_tot = - if !dbg_RelCheck then BU.print1 "Checking term %s\n" (Print.term_to_string e); + if !dbg_RelCheck then BU.print1 "Checking term %s\n" (show e); //let env, _ = Env.clear_expected_typ env in let env = {env with top_level=false; letrecs=[]} in let t, c, g = @@ -4537,12 +4544,12 @@ let typeof_tot_or_gtot_term env e must_tot = let c = N.maybe_ghost_to_pure_lcomp env c in if TcComm.is_total_lcomp c then t, c.res_typ, g - else raise_error (Errors.Fatal_UnexpectedImplictArgument, (BU.format1 "Implicit argument: Expected a total term; got a ghost term: %s" (Print.term_to_string e))) (Env.get_range env) + else raise_error (Errors.Fatal_UnexpectedImplictArgument, (BU.format1 "Implicit argument: Expected a total term; got a ghost term: %s" (show e))) (Env.get_range env) else t, c.res_typ, g -let level_of_type_fail env e t = +let level_of_type_fail env (e:term) (t:string) = raise_error_doc (Errors.Fatal_UnexpectedTermType, - [Errors.text (BU.format2 "Expected a type; got %s of type %s" (Print.term_to_string e) t)]) + [Errors.text (BU.format2 "Expected a type; got %s of type %s" (show e) t)]) (Env.get_range env) let level_of_type env e t = @@ -4566,7 +4573,7 @@ let level_of_type env e t = let g = FStar.TypeChecker.Rel.teq env t t_u in begin match g.guard_f with | NonTrivial f -> - level_of_type_fail env e (Print.term_to_string t) + level_of_type_fail env e (show t) | _ -> Rel.force_trivial_guard env g end; @@ -4630,7 +4637,7 @@ let rec universe_of_aux env e : term = | Tm_unknown | Tm_delayed _ -> failwith ("TcTerm.universe_of:Impossible (bvar/unknown/lazy) " ^ - (Print.term_to_string e)) + (show e)) //normalize let bindings away and then compute the universe | Tm_let _ -> let e = N.normalize [] env e in @@ -4668,9 +4675,9 @@ let rec universe_of_aux env e : term = | _ -> raise_error (Errors.Fatal_IncompatibleUniverse, BU.format3 "Incompatible universe application for %s, expected %s got %s\n" - (Print.fv_to_string fv) - (Print.univ_to_string ul) - (Print.univ_to_string ur)) + (show fv) + (show ul) + (show ur)) (Env.get_range env)) us' us; t @@ -4730,7 +4737,7 @@ let rec universe_of_aux env e : term = if !dbg_UniverseOf then BU.print2 "%s: About to type-check %s\n" (Range.string_of_range (Env.get_range env)) - (Print.term_to_string hd); + (show hd); let _, ({res_typ=t}), g = tc_term env hd in Rel.solve_deferred_constraints env g |> ignore; t, args @@ -4738,7 +4745,7 @@ let rec universe_of_aux env e : term = let t, args = type_of_head true env hd args in (match apply_well_typed env t args with | Some t -> t - | None -> level_of_type_fail env e (Print.term_to_string t)) + | None -> level_of_type_fail env e (show t)) | Tm_match {brs=b::_} -> //AR: TODO: use return annotation? let (pat, _, tm) = SS.open_branch b in let bvs = Syntax.pat_bvs pat in @@ -4750,12 +4757,12 @@ let rec universe_of_aux env e : term = let universe_of env e = Errors.with_ctx "While attempting to compute a universe level" (fun () -> if Debug.high () then - BU.print1 "Calling universe_of_aux with %s {\n" (Print.term_to_string e); + BU.print1 "Calling universe_of_aux with %s {\n" (show e); def_check_scoped e.pos "universe_of entry" env e; let r = universe_of_aux env e in if Debug.high () then - BU.print1 "Got result from universe_of_aux = %s }\n" (Print.term_to_string r); + BU.print1 "Got result from universe_of_aux = %s }\n" (show r); level_of_type env e r ) @@ -4772,7 +4779,7 @@ let rec __typeof_tot_or_gtot_term_fastpath (env:env) (t:term) (must_tot:bool) : let t = SS.compress t in match t.n with | Tm_delayed _ - | Tm_bvar _ -> failwith ("Impossible: " ^ Print.term_to_string t) + | Tm_bvar _ -> failwith ("Impossible: " ^ show t) (* Can't (easily) do this one efficiently, just return None *) | Tm_constant (Const_reify _) From 71240a61cf85e758691299efb05f1a09deb470f9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 4 May 2024 13:34:06 -0700 Subject: [PATCH 175/239] TcTerm: fix env --- src/typechecker/FStar.TypeChecker.TcTerm.fst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/typechecker/FStar.TypeChecker.TcTerm.fst b/src/typechecker/FStar.TypeChecker.TcTerm.fst index 3dfd176e4bd..ddc580b89fb 100644 --- a/src/typechecker/FStar.TypeChecker.TcTerm.fst +++ b/src/typechecker/FStar.TypeChecker.TcTerm.fst @@ -3374,7 +3374,7 @@ and tc_pat env (pat_t:typ) (p0:pat) : |> BU.first_N (List.length simple_bvs - List.length simple_bvs_pat) |> snd in - let g' = pat_typ_ok env simple_pat_t (expected_pat_typ env p0.p t) in + let g' = pat_typ_ok (Env.push_bvs env simple_bvs) simple_pat_t (expected_pat_typ env p0.p t) in // // Now solve guard // guard may have logical payload coming from typechecking of the From ae2d2bb6e012ce7ad9c8be5d1ad95e51d6d116fd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 6 May 2024 14:48:54 -0700 Subject: [PATCH 176/239] New test + update expected output --- tests/error-messages/PatternMatch.fst.expected | 3 +-- tests/error-messages/SMTPatSymbols.fst | 4 ++++ tests/error-messages/SMTPatSymbols.fst.expected | 7 +++++++ tests/ide/emacs/fstarmode_gh73.out.expected | 2 +- tests/ide/emacs/tutorial.push.out.expected | 2 +- 5 files changed, 14 insertions(+), 4 deletions(-) create mode 100644 tests/error-messages/SMTPatSymbols.fst create mode 100644 tests/error-messages/SMTPatSymbols.fst.expected diff --git a/tests/error-messages/PatternMatch.fst.expected b/tests/error-messages/PatternMatch.fst.expected index 29b451c8993..fb2ec797270 100644 --- a/tests/error-messages/PatternMatch.fst.expected +++ b/tests/error-messages/PatternMatch.fst.expected @@ -29,8 +29,7 @@ >>] >> Got issues: [ * Error 114 at PatternMatch.fst(35,4-35,5): - - Type of pattern (PatternMatch.ab) does not match type of scrutinee - (Prims.int) + - Type of pattern PatternMatch.ab does not match type of scrutinee Prims.int - Head mismatch PatternMatch.ab vs Prims.int >>] diff --git a/tests/error-messages/SMTPatSymbols.fst b/tests/error-messages/SMTPatSymbols.fst new file mode 100644 index 00000000000..b7bf9f001a7 --- /dev/null +++ b/tests/error-messages/SMTPatSymbols.fst @@ -0,0 +1,4 @@ +module SMTPatSymbols + +val lem (x:int) : Lemma (x > x-1) [SMTPat (x-1 + 1)] +let lem (x:int) : Lemma (x > x-1) [SMTPat (x-1)] = () diff --git a/tests/error-messages/SMTPatSymbols.fst.expected b/tests/error-messages/SMTPatSymbols.fst.expected new file mode 100644 index 00000000000..dc55da4985d --- /dev/null +++ b/tests/error-messages/SMTPatSymbols.fst.expected @@ -0,0 +1,7 @@ +* Warning 271 at SMTPatSymbols.fst(3,34-3,52): + - Pattern uses these theory symbols or terms that should not be in an SMT + pattern: + Prims.op_Addition, Prims.op_Subtraction + +Verified module: SMTPatSymbols +All verification conditions discharged successfully diff --git a/tests/ide/emacs/fstarmode_gh73.out.expected b/tests/ide/emacs/fstarmode_gh73.out.expected index 1daf84fb1d4..8af8e967970 100644 --- a/tests/ide/emacs/fstarmode_gh73.out.expected +++ b/tests/ide/emacs/fstarmode_gh73.out.expected @@ -1,5 +1,5 @@ {"kind": "protocol-info", "rest": "[...]"} -{"kind": "response", "query-id": "1", "response": [{"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [135, 17], "end": [135, 24], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [136, 22], "end": [136, 29], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Adding an implicit 'assume new' qualifier on document\n", "number": 239, "ranges": [{"beg": [36, 5], "end": [36, 13], "fname": "FStar.Stubs.Pprint.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [623, 15], "end": [623, 22], "fname": "FStar.Tactics.V2.Derived.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [176, 11], "end": [176, 18], "fname": "FStar.Tactics.V2.Logic.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Pattern uses these theory symbols or terms that should not be in an smt pattern: Prims.op_Subtraction\n", "number": 271, "ranges": [{"beg": [434, 8], "end": [434, 51], "fname": "FStar.UInt.fsti"}]}], "status": "success"} +{"kind": "response", "query-id": "1", "response": [{"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [135, 17], "end": [135, 24], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [136, 22], "end": [136, 29], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Adding an implicit 'assume new' qualifier on document\n", "number": 239, "ranges": [{"beg": [36, 5], "end": [36, 13], "fname": "FStar.Stubs.Pprint.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [623, 15], "end": [623, 22], "fname": "FStar.Tactics.V2.Derived.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [176, 11], "end": [176, 18], "fname": "FStar.Tactics.V2.Logic.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Pattern uses these theory symbols or terms that should not be in an SMT\n pattern:\n Prims.op_Subtraction\n", "number": 271, "ranges": [{"beg": [434, 8], "end": [434, 51], "fname": "FStar.UInt.fsti"}]}], "status": "success"} {"kind": "response", "query-id": "2", "response": [{"level": "error", "message": " - Expected expression of type int got expression \"A\" of type string\n", "number": 189, "ranges": [{"beg": [4, 48], "end": [4, 51], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "3", "response": [{"level": "error", "message": " - Expected expression of type int got expression \"A\" of type string\n", "number": 189, "ranges": [{"beg": [4, 48], "end": [4, 51], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "4", "response": [], "status": "success"} diff --git a/tests/ide/emacs/tutorial.push.out.expected b/tests/ide/emacs/tutorial.push.out.expected index 871ca3e45b9..4915da84619 100644 --- a/tests/ide/emacs/tutorial.push.out.expected +++ b/tests/ide/emacs/tutorial.push.out.expected @@ -1,5 +1,5 @@ {"kind": "protocol-info", "rest": "[...]"} -{"kind": "response", "query-id": "1", "response": [{"level": "warning", "message": " - Pattern uses these theory symbols or terms that should not be in an smt pattern: Prims.op_Subtraction\n", "number": 271, "ranges": [{"beg": [434, 8], "end": [434, 51], "fname": "FStar.UInt.fsti"}]}], "status": "success"} +{"kind": "response", "query-id": "1", "response": [{"level": "warning", "message": " - Pattern uses these theory symbols or terms that should not be in an SMT\n pattern:\n Prims.op_Subtraction\n", "number": 271, "ranges": [{"beg": [434, 8], "end": [434, 51], "fname": "FStar.UInt.fsti"}]}], "status": "success"} {"kind": "response", "query-id": "2", "response": [], "status": "success"} {"kind": "response", "query-id": "3", "response": [], "status": "success"} {"kind": "response", "query-id": "4", "response": [], "status": "success"} From dbd21380f17566b0d8c8a3fc004647298f629080 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 13 May 2024 05:00:42 -0700 Subject: [PATCH 177/239] Rel: if occurs check fails, attempt more normalization We can sometimes get a problem like ?u42 = Typeclasses.solve #_ #?u42 which should be trivial if we were to unfold `solve`, but the unifier will not do that automatically, even if `solve` is marked unfold. Instead, an occurs check fails and the unifier reports an error. This patch makes the unifier 1) normalize the RHS a bit more if the occurs check fails, in hope of simplifying it more (in this case, to ?u42) 2) solve the problem if it happens to become trivial after normalization (i.e. ?u42 = ?u42) Fixes #3264. --- src/typechecker/FStar.TypeChecker.Rel.fst | 33 ++++++++++++++++++++--- 1 file changed, 30 insertions(+), 3 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.Rel.fst b/src/typechecker/FStar.TypeChecker.Rel.fst index ebd3511bb21..d1511302b51 100644 --- a/src/typechecker/FStar.TypeChecker.Rel.fst +++ b/src/typechecker/FStar.TypeChecker.Rel.fst @@ -86,6 +86,11 @@ let is_base_type env typ = | Tm_type _ -> true | _ -> false +let term_is_uvar (uv:ctx_uvar) (t:term) : bool = + match (U.unascribe t).n with + | Tm_uvar (uv', _) -> UF.equiv uv.ctx_uvar_head uv'.ctx_uvar_head + | _ -> false + let binders_as_bv_set (bs:binders) : FlatSet.t bv = from_list (List.map (fun b -> b.binder_bv) bs) @@ -2824,8 +2829,10 @@ and solve_t (problem:tprob) (wl:worklist) : solution = and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) : solution = - if !dbg_Rel then - BU.print_string "solve_t_flex_rigid_eq\n"; + if !dbg_Rel then ( + BU.print1 "solve_t_flex_rigid_eq rhs=%s\n" + (show rhs) + ); if should_defer_flex_to_user_tac wl lhs then defer_to_user_tac orig (flex_reason lhs) wl @@ -3238,6 +3245,25 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) // (show rhs) // (show fvs2); let uvars, occurs_ok, msg = occurs_check ctx_uv rhs in + + (* If the occurs check fails, attempt to do a bit more normalization + and try it again. *) + let (uvars, occurs_ok, msg), rhs = + if occurs_ok + then (uvars, occurs_ok, msg), rhs + else + let rhs = N.normalize + [Env.Primops; Env.Weak; Env.HNF; Env.Beta; Env.Eager_unfolding; Env.Unascribe] + (p_env wl orig) rhs in + occurs_check ctx_uv rhs, rhs + in + + (* If, possibly after some extra normalization in the above block, + the RHS has become syntactically equal to the LHS, solve the problem + and carry on. See #3264. *) + if term_is_uvar ctx_uv rhs && Nil? args_lhs then + solve (solve_prob orig None [] wl) + else if not occurs_ok then giveup_or_defer orig wl Deferred_occur_check_failed @@ -3894,10 +3920,11 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = def_check_scoped (p_loc orig) "ref.t2" (List.map (fun b -> b.binder_bv) (p_scope orig)) t2; let _ = if !dbg_Rel - then BU.print4 "Attempting %s (%s vs %s); rel = (%s)\n" (string_of_int problem.pid) + then BU.print5 "Attempting %s (%s vs %s); rel = (%s); number of problems in wl = %s\n" (string_of_int problem.pid) (Print.tag_of_term t1 ^ "::" ^ show t1) (Print.tag_of_term t2 ^ "::" ^ show t2) (rel_to_string problem.relation) + (show (List.length wl.attempting)) in match t1.n, t2.n with | Tm_delayed _, _ From 56c776152f4b5412d2a7c61593afd9c6c3b56e41 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 6 May 2024 01:40:46 -0700 Subject: [PATCH 178/239] snap --- .../fstar-lib/generated/FStar_Syntax_Print.ml | 4 + .../generated/FStar_TypeChecker_Rel.ml | 192 +++-- .../generated/FStar_TypeChecker_TcTerm.ml | 655 +++++++++++------- 3 files changed, 530 insertions(+), 321 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml index b3fc89264c6..b4262aa55fe 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml @@ -1987,6 +1987,10 @@ let (showable_branch : FStar_Syntax_Syntax.branch FStar_Class_Show.showable) let (showable_qualifier : FStar_Syntax_Syntax.qualifier FStar_Class_Show.showable) = { FStar_Class_Show.show = qual_to_string } +let (showable_pat : FStar_Syntax_Syntax.pat FStar_Class_Show.showable) = + { FStar_Class_Show.show = pat_to_string } +let (showable_const : FStar_Const.sconst FStar_Class_Show.showable) = + { FStar_Class_Show.show = const_to_string } let (pretty_term : FStar_Syntax_Syntax.term FStar_Class_PP.pretty) = { FStar_Class_PP.pp = term_to_doc } let (pretty_univ : FStar_Syntax_Syntax.universe FStar_Class_PP.pretty) = diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml index 3b92d872542..e212fa19ca2 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml @@ -110,6 +110,18 @@ let (is_base_type : | FStar_Syntax_Syntax.Tm_fvar uu___2 -> true | FStar_Syntax_Syntax.Tm_type uu___2 -> true | uu___2 -> false) +let (term_is_uvar : + FStar_Syntax_Syntax.ctx_uvar -> FStar_Syntax_Syntax.term -> Prims.bool) = + fun uv -> + fun t -> + let uu___ = + let uu___1 = FStar_Syntax_Util.unascribe t in + uu___1.FStar_Syntax_Syntax.n in + match uu___ with + | FStar_Syntax_Syntax.Tm_uvar (uv', uu___1) -> + FStar_Syntax_Unionfind.equiv uv.FStar_Syntax_Syntax.ctx_uvar_head + uv'.FStar_Syntax_Syntax.ctx_uvar_head + | uu___1 -> false let (binders_as_bv_set : FStar_Syntax_Syntax.binders -> FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t) @@ -158,7 +170,7 @@ let (uu___is_DeferAny : defer_ok_t -> Prims.bool) = let (uu___is_DeferFlexFlexOnly : defer_ok_t -> Prims.bool) = fun projectee -> match projectee with | DeferFlexFlexOnly -> true | uu___ -> false -let (uu___78 : defer_ok_t FStar_Class_Show.showable) = +let (uu___85 : defer_ok_t FStar_Class_Show.showable) = { FStar_Class_Show.show = (fun uu___ -> @@ -6841,7 +6853,11 @@ and (solve_t_flex_rigid_eq : fun rhs -> (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 - then FStar_Compiler_Util.print_string "solve_t_flex_rigid_eq\n" + then + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term rhs in + FStar_Compiler_Util.print1 "solve_t_flex_rigid_eq rhs=%s\n" + uu___2 else ()); (let uu___1 = should_defer_flex_to_user_tac wl lhs in if uu___1 @@ -7700,68 +7716,102 @@ and (solve_t_flex_rigid_eq : let uu___6 = occurs_check ctx_uv rhs1 in match uu___6 with | (uvars, occurs_ok, msg) -> - if Prims.op_Negation occurs_ok - then - let uu___7 = - let uu___8 = - let uu___9 = - FStar_Compiler_Option.get msg in - Prims.strcat "occurs-check failed: " - uu___9 in - FStar_Thunk.mkv uu___8 in - giveup_or_defer orig wl - FStar_TypeChecker_Common.Deferred_occur_check_failed - uu___7 - else - (let uu___8 = - FStar_Class_Setlike.subset () - (Obj.magic - (FStar_Compiler_FlatSet.setlike_flat_set - FStar_Syntax_Syntax.ord_bv)) - (Obj.magic fvs2) (Obj.magic fvs1) in - if uu___8 - then - let sol = - mk_solution env lhs lhs_binders rhs1 in - let wl1 = - restrict_all_uvars env ctx_uv - lhs_binders uvars wl in - let uu___9 = - solve_prob orig - FStar_Pervasives_Native.None sol - wl1 in - solve uu___9 - else - if wl.defer_ok = DeferAny + let uu___7 = + if occurs_ok + then ((uvars, occurs_ok, msg), rhs1) + else + (let rhs2 = + FStar_TypeChecker_Normalize.normalize + [FStar_TypeChecker_Env.Primops; + FStar_TypeChecker_Env.Weak; + FStar_TypeChecker_Env.HNF; + FStar_TypeChecker_Env.Beta; + FStar_TypeChecker_Env.Eager_unfolding; + FStar_TypeChecker_Env.Unascribe] + (p_env wl orig) rhs1 in + let uu___9 = occurs_check ctx_uv rhs2 in + (uu___9, rhs2)) in + (match uu___7 with + | ((uvars1, occurs_ok1, msg1), rhs2) -> + let uu___8 = + (term_is_uvar ctx_uv rhs2) && + (Prims.uu___is_Nil args_lhs) in + if uu___8 then - (let msg1 = - mklstr - (fun uu___10 -> - let uu___11 = - FStar_Class_Show.show - (FStar_Compiler_FlatSet.showable_set - FStar_Syntax_Syntax.ord_bv - FStar_Syntax_Print.showable_bv) - fvs2 in - let uu___12 = - FStar_Class_Show.show - (FStar_Compiler_FlatSet.showable_set - FStar_Syntax_Syntax.ord_bv - FStar_Syntax_Print.showable_bv) - fvs1 in - let uu___13 = - FStar_Syntax_Print.binders_to_string - ", " - (FStar_Compiler_List.op_At - ctx_uv.FStar_Syntax_Syntax.ctx_uvar_binders - lhs_binders) in - FStar_Compiler_Util.format3 - "free names in the RHS {%s} are out of scope for the LHS: {%s}, {%s}" - uu___11 uu___12 uu___13) in - giveup_or_defer orig wl - FStar_TypeChecker_Common.Deferred_free_names_check_failed - msg1) - else imitate orig env wl lhs rhs1))) + let uu___9 = + solve_prob orig + FStar_Pervasives_Native.None [] + wl in + solve uu___9 + else + if Prims.op_Negation occurs_ok1 + then + (let uu___10 = + let uu___11 = + let uu___12 = + FStar_Compiler_Option.get + msg1 in + Prims.strcat + "occurs-check failed: " + uu___12 in + FStar_Thunk.mkv uu___11 in + giveup_or_defer orig wl + FStar_TypeChecker_Common.Deferred_occur_check_failed + uu___10) + else + (let uu___11 = + FStar_Class_Setlike.subset () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic fvs2) + (Obj.magic fvs1) in + if uu___11 + then + let sol = + mk_solution env lhs + lhs_binders rhs2 in + let wl1 = + restrict_all_uvars env ctx_uv + lhs_binders uvars1 wl in + let uu___12 = + solve_prob orig + FStar_Pervasives_Native.None + sol wl1 in + solve uu___12 + else + if wl.defer_ok = DeferAny + then + (let msg2 = + mklstr + (fun uu___13 -> + let uu___14 = + FStar_Class_Show.show + (FStar_Compiler_FlatSet.showable_set + FStar_Syntax_Syntax.ord_bv + FStar_Syntax_Print.showable_bv) + fvs2 in + let uu___15 = + FStar_Class_Show.show + (FStar_Compiler_FlatSet.showable_set + FStar_Syntax_Syntax.ord_bv + FStar_Syntax_Print.showable_bv) + fvs1 in + let uu___16 = + FStar_Syntax_Print.binders_to_string + ", " + (FStar_Compiler_List.op_At + ctx_uv.FStar_Syntax_Syntax.ctx_uvar_binders + lhs_binders) in + FStar_Compiler_Util.format3 + "free names in the RHS {%s} are out of scope for the LHS: {%s}, {%s}" + uu___14 uu___15 + uu___16) in + giveup_or_defer orig wl + FStar_TypeChecker_Common.Deferred_free_names_check_failed + msg2) + else + imitate orig env wl lhs rhs2)))) | uu___5 -> if wl.defer_ok = DeferAny then @@ -7951,7 +8001,7 @@ and (solve_t_flex_flex : let uu___21 = let uu___22 = FStar_Class_Show.show - uu___78 wl.defer_ok in + uu___85 wl.defer_ok in FStar_Compiler_Util.format1 "flex-flex: occurs\n defer_ok=%s\n" uu___22 in @@ -9409,10 +9459,16 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_Class_Show.show FStar_Syntax_Print.showable_term t2 in Prims.strcat "::" uu___13 in Prims.strcat uu___11 uu___12 in - FStar_Compiler_Util.print4 - "Attempting %s (%s vs %s); rel = (%s)\n" uu___8 uu___9 - uu___10 + let uu___11 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_nat) + (FStar_Compiler_List.length wl.attempting) in + FStar_Compiler_Util.print5 + "Attempting %s (%s vs %s); rel = (%s); number of problems in wl = %s\n" + uu___8 uu___9 uu___10 (rel_to_string problem.FStar_TypeChecker_Common.relation) + uu___11 else ()); (match ((t1.FStar_Syntax_Syntax.n), (t2.FStar_Syntax_Syntax.n)) with @@ -14470,7 +14526,7 @@ let (try_solve_deferred_constraints : (let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___4 then - let uu___5 = FStar_Class_Show.show uu___78 defer_ok in + let uu___5 = FStar_Class_Show.show uu___85 defer_ok in let uu___6 = FStar_Class_Show.show (FStar_Class_Show.printableshow diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml index 8980bfd17a7..fbaf359917a 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml @@ -229,7 +229,9 @@ let (check_no_escape : let uu___3 = let uu___4 = let uu___5 = - let uu___6 = FStar_Syntax_Print.bv_to_string x in + let uu___6 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv x in FStar_Pprint.doc_of_string uu___6 in FStar_Pprint.squotes uu___5 in let uu___5 = @@ -249,7 +251,9 @@ let (check_no_escape : let uu___3 = let uu___4 = let uu___5 = - let uu___6 = FStar_Syntax_Print.bv_to_string x in + let uu___6 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv x in FStar_Pprint.doc_of_string uu___6 in FStar_Pprint.squotes uu___5 in let uu___5 = @@ -541,7 +545,9 @@ let (value_check_expected_typ : then let uu___6 = FStar_TypeChecker_Common.lcomp_to_string lc1 in - let uu___7 = FStar_Syntax_Print.term_to_string t' in + let uu___7 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t' in let uu___8 = FStar_TypeChecker_Rel.guard_to_string env g in let uu___9 = @@ -802,11 +808,14 @@ let (check_expected_effect : if uu___8 then let uu___9 = - FStar_Syntax_Print.term_to_string e in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e in let uu___10 = - FStar_Syntax_Print.comp_to_string c4 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_comp c4 in let uu___11 = - FStar_Syntax_Print.comp_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_comp expected_c in let uu___12 = FStar_Compiler_Util.string_of_bool @@ -879,7 +888,7 @@ let (print_expected_ty_str : FStar_TypeChecker_Env.env -> Prims.string) = match uu___ with | FStar_Pervasives_Native.None -> "Expected type is None" | FStar_Pervasives_Native.Some (t, use_eq) -> - let uu___1 = FStar_Syntax_Print.term_to_string t in + let uu___1 = FStar_Class_Show.show FStar_Syntax_Print.showable_term t in let uu___2 = FStar_Compiler_Util.string_of_bool use_eq in FStar_Compiler_Util.format2 "Expected type is (%s, use_eq = %s)" uu___1 uu___2 @@ -1023,7 +1032,8 @@ let (check_pat_fvs : -> let uu___4 = let uu___5 = - let uu___6 = FStar_Syntax_Print.bv_to_string x in + let uu___6 = + FStar_Class_Show.show FStar_Syntax_Print.showable_bv x in FStar_Compiler_Util.format1 "Pattern misses at least one bound variable: %s" uu___6 in (FStar_Errors_Codes.Warning_SMTPatternIllFormed, uu___5) in @@ -1113,21 +1123,25 @@ let (check_no_smt_theory_symbols : if (FStar_Compiler_List.length tlist) = Prims.int_zero then () else - (let msg = - FStar_Compiler_List.fold_left - (fun s -> - fun t1 -> - let uu___1 = - let uu___2 = FStar_Syntax_Print.term_to_string t1 in - Prims.strcat " " uu___2 in - Prims.strcat s uu___1) "" tlist in - let uu___1 = + (let uu___1 = let uu___2 = - FStar_Compiler_Util.format1 - "Pattern uses these theory symbols or terms that should not be in an smt pattern: %s" - msg in + let uu___3 = + let uu___4 = + FStar_Errors_Msg.text + "Pattern uses these theory symbols or terms that should not be in an SMT pattern:" in + let uu___5 = + let uu___6 = + let uu___7 = + let uu___8 = FStar_Pprint.break_ Prims.int_one in + FStar_Pprint.op_Hat_Hat FStar_Pprint.comma uu___8 in + FStar_Pprint.separate_map uu___7 + (FStar_Class_PP.pp FStar_Syntax_Print.pretty_term) tlist in + FStar_Pprint.group uu___6 in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one uu___4 + uu___5 in + [uu___3] in (FStar_Errors_Codes.Warning_SMTPatternIllFormed, uu___2) in - FStar_Errors.log_issue t.FStar_Syntax_Syntax.pos uu___1) + FStar_Errors.log_issue_doc t.FStar_Syntax_Syntax.pos uu___1) let (check_smt_pat : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> @@ -1279,7 +1293,8 @@ let (guard_letrecs : if uu___1 then let uu___2 = FStar_Syntax_Print.binders_to_string ", " bs in - let uu___3 = FStar_Syntax_Print.comp_to_string c in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_comp c in FStar_Compiler_Util.print2 "Building a decreases clause over (%s) and %s\n" uu___2 uu___3 @@ -1429,19 +1444,23 @@ let (guard_letrecs : let uu___7 = let uu___8 = let uu___9 = - FStar_Syntax_Print.term_to_string e1 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e1 in let uu___10 = FStar_Compiler_Range_Ops.string_of_range e1.FStar_Syntax_Syntax.pos in let uu___11 = - FStar_Syntax_Print.term_to_string t1 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t1 in let uu___12 = - FStar_Syntax_Print.term_to_string e2 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e2 in let uu___13 = FStar_Compiler_Range_Ops.string_of_range e2.FStar_Syntax_Syntax.pos in let uu___14 = - FStar_Syntax_Print.term_to_string t2 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t2 in FStar_Compiler_Util.format6 "SMT may not be able to prove the types of %s at %s (%s) and %s at %s (%s) to be equal, if the proof fails, try annotating these with the same type" uu___9 uu___10 uu___11 uu___12 uu___13 @@ -1659,11 +1678,16 @@ let (guard_letrecs : if uu___5 then let uu___6 = - FStar_Syntax_Print.lbname_to_string l in + FStar_Class_Show.show + (FStar_Class_Show.show_either + FStar_Syntax_Print.showable_bv + FStar_Syntax_Print.showable_fv) l in let uu___7 = - FStar_Syntax_Print.term_to_string t in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in let uu___8 = - FStar_Syntax_Print.term_to_string t' in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t' in FStar_Compiler_Util.print3 "Refined let rec %s\n\tfrom type %s\n\tto type %s\n" uu___6 uu___7 uu___8 @@ -1741,7 +1765,8 @@ let rec (tc_term : let uu___4 = FStar_Compiler_Util.string_of_bool env.FStar_TypeChecker_Env.phase1 in - let uu___5 = FStar_Syntax_Print.term_to_string e in + let uu___5 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term e in let uu___6 = let uu___7 = FStar_Syntax_Subst.compress e in FStar_Syntax_Print.tag_of_term uu___7 in @@ -1865,7 +1890,8 @@ let rec (tc_term : ((let uu___6 = let uu___7 = FStar_TypeChecker_Env.get_range env in FStar_Compiler_Range_Ops.string_of_range uu___7 in - let uu___7 = FStar_Syntax_Print.term_to_string e in + let uu___7 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term e in let uu___8 = let uu___9 = FStar_Syntax_Subst.compress e in FStar_Syntax_Print.tag_of_term uu___9 in @@ -1879,7 +1905,9 @@ let rec (tc_term : let uu___8 = let uu___9 = FStar_TypeChecker_Env.get_range env in FStar_Compiler_Range_Ops.string_of_range uu___9 in - let uu___9 = FStar_Syntax_Print.term_to_string e1 in + let uu___9 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term + e1 in let uu___10 = FStar_TypeChecker_Common.lcomp_to_string lc in let uu___11 = @@ -2496,7 +2524,8 @@ and (tc_maybe_toplevel_term : if uu___12 then let uu___13 = - FStar_Syntax_Print.term_to_string e2 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e2 in FStar_Compiler_Util.print1 "Typechecking ascribed reflect, inner ascribed term: %s\n" uu___13 @@ -2510,7 +2539,8 @@ and (tc_maybe_toplevel_term : if uu___15 then let uu___16 = - FStar_Syntax_Print.term_to_string e4 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e4 in let uu___17 = FStar_TypeChecker_Rel.guard_to_string env0 g_e in @@ -2904,7 +2934,8 @@ and (tc_maybe_toplevel_term : -> let uu___6 = let uu___7 = - let uu___8 = FStar_Syntax_Print.term_to_string top in + let uu___8 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term top in FStar_Compiler_Util.format1 "Ill-applied constant %s" uu___8 in (FStar_Errors_Codes.Fatal_IllAppliedConstant, uu___7) in FStar_Errors.raise_error uu___6 e.FStar_Syntax_Syntax.pos @@ -2921,7 +2952,8 @@ and (tc_maybe_toplevel_term : -> let uu___6 = let uu___7 = - let uu___8 = FStar_Syntax_Print.term_to_string top in + let uu___8 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term top in FStar_Compiler_Util.format1 "Ill-applied constant %s" uu___8 in (FStar_Errors_Codes.Fatal_IllAppliedConstant, uu___7) in FStar_Errors.raise_error uu___6 e.FStar_Syntax_Syntax.pos @@ -3138,7 +3170,8 @@ and (tc_maybe_toplevel_term : FStar_Syntax_Print.tag_of_term expected_repr_typ in let uu___20 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term expected_repr_typ in FStar_Compiler_Util.format3 "Expected repr type for %s is not an application node (%s:%s)" @@ -3381,11 +3414,15 @@ and (tc_maybe_toplevel_term : if uu___12 then let uu___13 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term lc.FStar_TypeChecker_Common.res_typ in - let uu___14 = FStar_Syntax_Print.term_to_string t0 in + let uu___14 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t0 in let uu___15 = - FStar_Syntax_Print.term_to_string thead in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term thead in FStar_Compiler_Util.print3 "Got lc.res_typ=%s; t0 = %s; thead = %s\n" uu___13 uu___14 uu___15 @@ -3517,7 +3554,8 @@ and (tc_maybe_toplevel_term : let uu___4 = FStar_Compiler_Range_Ops.string_of_range top.FStar_Syntax_Syntax.pos in - let uu___5 = FStar_Syntax_Print.term_to_string top in + let uu___5 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term top in let uu___6 = print_expected_ty_str env0 in FStar_Compiler_Util.print3 "(%s) Checking app %s, %s\n" uu___4 uu___5 uu___6 @@ -3607,7 +3645,8 @@ and (tc_maybe_toplevel_term : if uu___10 then let uu___11 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e3 in let uu___12 = FStar_TypeChecker_Rel.guard_to_string @@ -3751,7 +3790,8 @@ and (tc_match : let uu___7 = let uu___8 = let uu___9 = - FStar_Syntax_Print.term_to_string e12 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e12 in let uu___10 = FStar_Ident.string_of_lid c11.FStar_TypeChecker_Common.eff_name in @@ -4254,7 +4294,8 @@ and (tc_synth : (let uu___4 = let uu___5 = let uu___6 = - FStar_Syntax_Print.term_to_string t in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in FStar_Compiler_Util.format1 "Equality ascription in synth (%s) is not yet supported, please use subtyping" uu___6 in @@ -4302,7 +4343,8 @@ and (tc_synth : if uu___9 then let uu___10 = - FStar_Syntax_Print.term_to_string t in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in FStar_Compiler_Util.print1 "Got %s\n" uu___10 else ()); FStar_TypeChecker_Util.check_uvars @@ -4495,7 +4537,8 @@ and (tc_value : | FStar_Syntax_Syntax.Tm_bvar x -> let uu___ = let uu___1 = - let uu___2 = FStar_Syntax_Print.term_to_string top in + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term top in FStar_Compiler_Util.format1 "Violation of locally nameless convention: %s" uu___2 in (FStar_Errors_Codes.Error_IllScopedTerm, uu___1) in @@ -4524,7 +4567,9 @@ and (tc_value : then (let uu___3 = let uu___4 = - let uu___5 = FStar_Syntax_Print.term_to_string t in + let uu___5 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in FStar_Compiler_Util.format1 "Equality ascription as an expected type for unk (:%s) is not yet supported, please use subtyping" uu___5 in @@ -4618,7 +4663,9 @@ and (tc_value : then (let uu___6 = let uu___7 = - let uu___8 = FStar_Syntax_Print.fv_to_string fv1 in + let uu___8 = + FStar_Class_Show.show FStar_Syntax_Print.showable_fv + fv1 in let uu___9 = FStar_Compiler_Util.string_of_int (FStar_Compiler_List.length us1) in @@ -4646,11 +4693,14 @@ and (tc_value : let uu___8 = let uu___9 = let uu___10 = - FStar_Syntax_Print.fv_to_string fv1 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_fv fv1 in let uu___11 = - FStar_Syntax_Print.univ_to_string ul in + FStar_Class_Show.show + FStar_Syntax_Print.showable_univ ul in let uu___12 = - FStar_Syntax_Print.univ_to_string ur in + FStar_Class_Show.show + FStar_Syntax_Print.showable_univ ur in FStar_Compiler_Util.format3 "Incompatible universe application for %s, expected %s got %s\n" uu___10 uu___11 uu___12 in @@ -4685,7 +4735,7 @@ and (tc_value : then let uu___4 = let uu___5 = FStar_Syntax_Syntax.lid_of_fv fv1 in - FStar_Syntax_Print.lid_to_string uu___5 in + FStar_Class_Show.show FStar_Ident.showable_lident uu___5 in let uu___5 = FStar_Compiler_Range_Ops.string_of_range e.FStar_Syntax_Syntax.pos in @@ -4693,7 +4743,8 @@ and (tc_value : FStar_Compiler_Range_Ops.string_of_range range in let uu___7 = FStar_Compiler_Range_Ops.string_of_use_range range in - let uu___8 = FStar_Syntax_Print.term_to_string t in + let uu___8 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t in FStar_Compiler_Util.print5 "Lookup up fvar %s at location %s (lid range = defined at %s, used at %s); got universes type %s\n" uu___4 uu___5 uu___6 uu___7 uu___8 @@ -4795,9 +4846,11 @@ and (tc_value : FStar_Compiler_Range_Ops.string_of_range top.FStar_Syntax_Syntax.pos in let uu___7 = - FStar_Syntax_Print.term_to_string phi1 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term phi1 in let uu___8 = - FStar_Syntax_Print.bv_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv x2.FStar_Syntax_Syntax.binder_bv in FStar_Compiler_Util.print3 "(%s) Checking refinement formula %s; binder is %s\n" @@ -4850,7 +4903,7 @@ and (tc_value : if uu___2 then let uu___3 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show FStar_Syntax_Print.showable_term { FStar_Syntax_Syntax.n = (FStar_Syntax_Syntax.Tm_abs @@ -4871,7 +4924,8 @@ and (tc_value : match uu___2 with | (bs2, body1) -> tc_abs env1 top bs2 body1)) | uu___ -> let uu___1 = - let uu___2 = FStar_Syntax_Print.term_to_string top in + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term top in let uu___3 = FStar_Syntax_Print.tag_of_term top in FStar_Compiler_Util.format2 "Unexpected value: %s (%s)" uu___2 uu___3 in @@ -5305,7 +5359,9 @@ and (tc_universe : else (let uu___2 = let uu___3 = - let uu___4 = FStar_Syntax_Print.univ_to_string u2 in + let uu___4 = + FStar_Class_Show.show FStar_Syntax_Print.showable_univ + u2 in Prims.strcat uu___4 " not found" in Prims.strcat "Universe variable " uu___3 in FStar_Compiler_Effect.failwith uu___2) in @@ -5998,7 +6054,9 @@ and (tc_abs_check_binders : then let uu___3 = let uu___4 = - let uu___5 = FStar_Syntax_Print.bv_to_string hd in + let uu___5 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv hd in FStar_Compiler_Util.format1 "Inconsistent implicit argument annotation on argument %s" uu___5 in @@ -6024,7 +6082,9 @@ and (tc_abs_check_binders : then let uu___4 = let uu___5 = - let uu___6 = FStar_Syntax_Print.bv_to_string hd in + let uu___6 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv hd in FStar_Compiler_Util.format3 "Inconsistent positivity qualifier on argument %s; Expected qualifier %s, found qualifier %s" uu___6 @@ -6053,7 +6113,8 @@ and (tc_abs_check_binders : if uu___7 then let uu___8 = - FStar_Syntax_Print.bv_to_string hd in + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv hd in FStar_Compiler_Util.print1 "Checking binder %s\n" uu___8 else ()); @@ -6206,7 +6267,9 @@ and (tc_abs : match topt with | FStar_Pervasives_Native.None -> "None" | FStar_Pervasives_Native.Some (t, use_eq) -> - let uu___4 = FStar_Syntax_Print.term_to_string t in + let uu___4 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in let uu___5 = let uu___6 = FStar_Compiler_Util.string_of_bool use_eq in @@ -6232,12 +6295,14 @@ and (tc_abs : match tfun_opt with | FStar_Pervasives_Native.None -> "None" | FStar_Pervasives_Native.Some t -> - FStar_Syntax_Print.term_to_string t in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in let uu___6 = match c_opt with | FStar_Pervasives_Native.None -> "None" | FStar_Pervasives_Native.Some t -> - FStar_Syntax_Print.comp_to_string t in + FStar_Class_Show.show + FStar_Syntax_Print.showable_comp t in let uu___7 = let uu___8 = FStar_TypeChecker_Env.expected_typ envbody in @@ -6245,7 +6310,8 @@ and (tc_abs : | FStar_Pervasives_Native.None -> "None" | FStar_Pervasives_Native.Some (t, use_eq) -> let uu___9 = - FStar_Syntax_Print.term_to_string t in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in let uu___10 = let uu___11 = FStar_Compiler_Util.string_of_bool use_eq in @@ -6565,7 +6631,8 @@ and (tc_abs : let uu___12 = let uu___13 = let uu___14 = - FStar_Syntax_Print.binder_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_binder b in FStar_Compiler_Util.format1 "Binder %s is marked unused, but its use in the definition is not" @@ -6593,7 +6660,8 @@ and (tc_abs : let uu___12 = let uu___13 = let uu___14 = - FStar_Syntax_Print.binder_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_binder b in FStar_Compiler_Util.format1 "Binder %s is marked strictly positive, but its use in the definition is not" @@ -6738,7 +6806,8 @@ and (check_application_args : if uu___6 then let uu___7 = - FStar_Syntax_Print.comp_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_comp cres2 in FStar_Compiler_Util.print1 "\t Type of result cres is %s\n" @@ -6799,7 +6868,8 @@ and (check_application_args : if uu___10 then let uu___11 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term term in FStar_Compiler_Util.print1 "(a) Monadic app: Return inserted in monadic application: %s\n" @@ -6816,7 +6886,8 @@ and (check_application_args : if uu___11 then let uu___12 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term term in FStar_Compiler_Util.print1 "(a) Monadic app: No return inserted in monadic application: %s\n" @@ -6884,11 +6955,13 @@ and (check_application_args : | FStar_Pervasives_Native.Some x1 -> - FStar_Syntax_Print.bv_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv x1 in let uu___14 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e in let uu___15 = @@ -6963,7 +7036,8 @@ and (check_application_args : if uu___11 then let uu___12 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term head1 in let uu___13 = FStar_TypeChecker_Common.lcomp_to_string @@ -7048,7 +7122,8 @@ and (check_application_args : if uu___13 then let uu___14 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e in let uu___15 = FStar_TypeChecker_Common.lcomp_to_string @@ -7579,9 +7654,12 @@ and (check_application_args : let uu___7 = FStar_Syntax_Print.tag_of_term e in let uu___8 = - FStar_Syntax_Print.term_to_string e in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e in let uu___9 = - FStar_Syntax_Print.term_to_string targ1 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + targ1 in let uu___10 = FStar_Compiler_Util.string_of_bool (is_eq bqual1) in @@ -7841,11 +7919,14 @@ and (check_application_args : if uu___6 then let uu___7 = - FStar_Syntax_Print.term_to_string head in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term head in let uu___8 = - FStar_Syntax_Print.term_to_string tf in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term tf in let uu___9 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term bs_cres in FStar_Compiler_Util.print3 "Forcing the type of %s from %s to %s\n" @@ -7928,11 +8009,14 @@ and (check_application_args : if uu___10 then let uu___11 = - FStar_Syntax_Print.term_to_string head in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term head in let uu___12 = - FStar_Syntax_Print.term_to_string tf in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term tf in let uu___13 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term bs_cres in FStar_Compiler_Util.print3 "Forcing the type of %s from %s to %s\n" @@ -7958,13 +8042,16 @@ and (check_application_args : if uu___4 then let uu___5 = - FStar_Syntax_Print.term_to_string head in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term head in let uu___6 = - FStar_Syntax_Print.term_to_string tf in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term tf in let uu___7 = FStar_Syntax_Print.binders_to_string ", " bs1 in let uu___8 = - FStar_Syntax_Print.comp_to_string c1 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_comp c1 in FStar_Compiler_Util.print4 "######tc_args of head %s @ %s with formals=%s and result type=%s\n" uu___5 uu___6 uu___7 uu___8 @@ -8159,64 +8246,80 @@ and (tc_pat : (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Patterns in if uu___1 then - let uu___2 = FStar_Syntax_Print.term_to_string pat_t1 in - let uu___3 = FStar_Syntax_Print.term_to_string scrutinee_t in + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term pat_t1 in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term + scrutinee_t in FStar_Compiler_Util.print2 "$$$$$$$$$$$$pat_typ_ok? %s vs. %s\n" uu___2 uu___3 else ()); + FStar_Defensive.def_check_scoped + FStar_TypeChecker_Env.hasBinders_env + FStar_Class_Binders.hasNames_term FStar_Syntax_Print.pretty_term + pat_t1.FStar_Syntax_Syntax.pos "pat_typ_ok.pat_t.entry" env1 + pat_t1; (let fail1 msg_str = let msg = if msg_str = "" then [] - else (let uu___2 = FStar_Errors_Msg.text msg_str in [uu___2]) in + else (let uu___3 = FStar_Errors_Msg.text msg_str in [uu___3]) in let msg1 = - let uu___1 = - let uu___2 = - let uu___3 = FStar_Syntax_Print.term_to_string pat_t1 in - let uu___4 = FStar_Syntax_Print.term_to_string scrutinee_t in - FStar_Compiler_Util.format2 - "Type of pattern (%s) does not match type of scrutinee (%s)" - uu___3 uu___4 in - FStar_Errors_Msg.text uu___2 in - uu___1 :: msg in + let uu___2 = + let uu___3 = + let uu___4 = FStar_Errors_Msg.text "Type of pattern" in + let uu___5 = + FStar_Class_PP.pp FStar_Syntax_Print.pretty_term pat_t1 in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one + uu___4 uu___5 in + let uu___4 = + let uu___5 = + FStar_Errors_Msg.text "does not match type of scrutinee" in + let uu___6 = + FStar_Class_PP.pp FStar_Syntax_Print.pretty_term + scrutinee_t in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one + uu___5 uu___6 in + FStar_Pprint.op_Hat_Slash_Hat uu___3 uu___4 in + uu___2 :: msg in FStar_Errors.raise_error_doc (FStar_Errors_Codes.Fatal_MismatchedPatternType, msg1) p0.FStar_Syntax_Syntax.p in - let uu___1 = FStar_Syntax_Util.head_and_args scrutinee_t in - match uu___1 with + let uu___2 = FStar_Syntax_Util.head_and_args scrutinee_t in + match uu___2 with | (head_s, args_s) -> let pat_t2 = FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Env.Beta] env1 pat_t1 in - let uu___2 = FStar_Syntax_Util.un_uinst head_s in - (match uu___2 with + let uu___3 = FStar_Syntax_Util.un_uinst head_s in + (match uu___3 with | { FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar - uu___3; - FStar_Syntax_Syntax.pos = uu___4; - FStar_Syntax_Syntax.vars = uu___5; - FStar_Syntax_Syntax.hash_code = uu___6;_} -> - let uu___7 = FStar_Syntax_Util.head_and_args pat_t2 in - (match uu___7 with + uu___4; + FStar_Syntax_Syntax.pos = uu___5; + FStar_Syntax_Syntax.vars = uu___6; + FStar_Syntax_Syntax.hash_code = uu___7;_} -> + let uu___8 = FStar_Syntax_Util.head_and_args pat_t2 in + (match uu___8 with | (head_p, args_p) -> - let uu___8 = + let uu___9 = FStar_TypeChecker_Rel.teq_nosmt_force env1 head_p head_s in - if uu___8 + if uu___9 then - let uu___9 = - let uu___10 = FStar_Syntax_Util.un_uinst head_p in - uu___10.FStar_Syntax_Syntax.n in - (match uu___9 with + let uu___10 = + let uu___11 = FStar_Syntax_Util.un_uinst head_p in + uu___11.FStar_Syntax_Syntax.n in + (match uu___10 with | FStar_Syntax_Syntax.Tm_fvar f -> - ((let uu___11 = - let uu___12 = - let uu___13 = + ((let uu___12 = + let uu___13 = + let uu___14 = FStar_Syntax_Syntax.lid_of_fv f in FStar_TypeChecker_Env.is_type_constructor - env1 uu___13 in - Prims.op_Negation uu___12 in - if uu___11 + env1 uu___14 in + Prims.op_Negation uu___13 in + if uu___12 then fail1 "Pattern matching a non-inductive type" @@ -8226,53 +8329,55 @@ and (tc_pat : (FStar_Compiler_List.length args_s) then fail1 "" else (); - (let uu___12 = - let uu___13 = - let uu___14 = + (let uu___13 = + let uu___14 = + let uu___15 = FStar_Syntax_Syntax.lid_of_fv f in FStar_TypeChecker_Env.num_inductive_ty_params - env1 uu___14 in - match uu___13 with + env1 uu___15 in + match uu___14 with | FStar_Pervasives_Native.None -> (args_p, args_s) | FStar_Pervasives_Native.Some n -> - let uu___14 = + let uu___15 = FStar_Compiler_Util.first_N n args_p in - (match uu___14 with - | (params_p, uu___15) -> - let uu___16 = + (match uu___15 with + | (params_p, uu___16) -> + let uu___17 = FStar_Compiler_Util.first_N n args_s in - (match uu___16 with - | (params_s, uu___17) -> + (match uu___17 with + | (params_s, uu___18) -> (params_p, params_s))) in - match uu___12 with + match uu___13 with | (params_p, params_s) -> FStar_Compiler_List.fold_left2 (fun out -> - fun uu___13 -> - fun uu___14 -> - match (uu___13, uu___14) with - | ((p, uu___15), (s, uu___16)) + fun uu___14 -> + fun uu___15 -> + match (uu___14, uu___15) with + | ((p, uu___16), (s, uu___17)) -> - let uu___17 = + let uu___18 = FStar_TypeChecker_Rel.teq_nosmt env1 p s in - (match uu___17 with + (match uu___18 with | FStar_Pervasives_Native.None -> - let uu___18 = - let uu___19 = - FStar_Syntax_Print.term_to_string - p in + let uu___19 = let uu___20 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + p in + let uu___21 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term s in FStar_Compiler_Util.format2 "Parameter %s <> Parameter %s" - uu___19 uu___20 in - fail1 uu___18 + uu___20 uu___21 in + fail1 uu___19 | FStar_Pervasives_Native.Some g -> let g1 = @@ -8282,21 +8387,23 @@ and (tc_pat : g1 out)) FStar_TypeChecker_Env.trivial_guard params_p params_s)) - | uu___10 -> + | uu___11 -> fail1 "Pattern matching a non-inductive type") else - (let uu___10 = - let uu___11 = - FStar_Syntax_Print.term_to_string head_p in + (let uu___11 = let uu___12 = - FStar_Syntax_Print.term_to_string head_s in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term head_p in + let uu___13 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term head_s in FStar_Compiler_Util.format2 - "Head mismatch %s vs %s" uu___11 uu___12 in - fail1 uu___10)) - | uu___3 -> - let uu___4 = + "Head mismatch %s vs %s" uu___12 uu___13 in + fail1 uu___11)) + | uu___4 -> + let uu___5 = FStar_TypeChecker_Rel.teq_nosmt env1 pat_t2 scrutinee_t in - (match uu___4 with + (match uu___5 with | FStar_Pervasives_Native.None -> fail1 "" | FStar_Pervasives_Native.Some g -> let g1 = @@ -8627,8 +8734,10 @@ and (tc_pat : (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Patterns in if uu___1 then - let uu___2 = FStar_Syntax_Print.pat_to_string p in - let uu___3 = FStar_Syntax_Print.term_to_string t in + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_pat p in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t in FStar_Compiler_Util.print2 "Checking pattern %s at type %s\n" uu___2 uu___3 else ()); @@ -8699,7 +8808,8 @@ and (tc_pat : match p.FStar_Syntax_Syntax.v with | FStar_Syntax_Syntax.Pat_dot_term uu___1 -> let uu___2 = - let uu___3 = FStar_Syntax_Print.pat_to_string p in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_pat p in FStar_Compiler_Util.format1 "Impossible: Expected an undecorated pattern, got %s" uu___3 in @@ -8728,7 +8838,9 @@ and (tc_pat : | FStar_Const.Const_string uu___2 -> () | uu___2 -> let uu___3 = - let uu___4 = FStar_Syntax_Print.const_to_string c in + let uu___4 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_const c in FStar_Compiler_Util.format1 "Pattern matching a constant that does not have decidable equality: %s" uu___4 in @@ -8755,10 +8867,12 @@ and (tc_pat : then let uu___10 = let uu___11 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term lc.FStar_TypeChecker_Common.res_typ in let uu___12 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term expected_t in FStar_Compiler_Util.format2 "Type of pattern (%s) does not match type of scrutinee (%s)" @@ -8860,7 +8974,8 @@ and (tc_pat : FStar_Compiler_Range_Ops.string_of_range p.FStar_Syntax_Syntax.p in let uu___5 = - FStar_Syntax_Print.pat_to_string simple_pat in + FStar_Class_Show.show + FStar_Syntax_Print.showable_pat simple_pat in let uu___6 = FStar_Compiler_Util.string_of_int (FStar_Compiler_List.length sub_pats1) in @@ -8886,9 +9001,12 @@ and (tc_pat : FStar_Pervasives_Native.snd uu___5 in let g' = let uu___5 = + FStar_TypeChecker_Env.push_bvs env1 + simple_bvs1 in + let uu___6 = expected_pat_typ env1 p0.FStar_Syntax_Syntax.p t in - pat_typ_ok env1 simple_pat_t uu___5 in + pat_typ_ok uu___5 simple_pat_t uu___6 in let guard1 = let fml = FStar_TypeChecker_Env.guard_form guard in @@ -8926,10 +9044,12 @@ and (tc_pat : if uu___6 then let uu___7 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term simple_pat_e1 in let uu___8 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term simple_pat_t in let uu___9 = let uu___10 = @@ -8937,12 +9057,14 @@ and (tc_pat : (fun x -> let uu___11 = let uu___12 = - FStar_Syntax_Print.bv_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv x in let uu___13 = let uu___14 = let uu___15 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term x.FStar_Syntax_Syntax.sort in Prims.strcat uu___15 ")" in Prims.strcat " : " uu___14 in @@ -9108,7 +9230,8 @@ and (tc_pat : (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Patterns in if uu___1 then - let uu___2 = FStar_Syntax_Print.pat_to_string p0 in + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_pat p0 in FStar_Compiler_Util.print1 "Checking pattern: %s\n" uu___2 else ()); (let uu___1 = @@ -9127,8 +9250,11 @@ and (tc_pat : ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_Patterns in if uu___3 then - let uu___4 = FStar_Syntax_Print.pat_to_string pat in - let uu___5 = FStar_Syntax_Print.term_to_string pat_e in + let uu___4 = + FStar_Class_Show.show FStar_Syntax_Print.showable_pat pat in + let uu___5 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term + pat_e in FStar_Compiler_Util.print2 "Done checking pattern %s as expression %s\n" uu___4 uu___5 @@ -9178,23 +9304,18 @@ and (tc_eqn : if uu___7 then let uu___8 = - FStar_Syntax_Print.pat_to_string pattern1 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_pat pattern1 in let uu___9 = FStar_Syntax_Print.bvs_to_string ";" pat_bvs in let uu___10 = - FStar_Compiler_List.fold_left - (fun s -> - fun t -> - let uu___11 = - let uu___12 = - FStar_Syntax_Print.term_to_string - t in - Prims.strcat ";" uu___12 in - Prims.strcat s uu___11) "" + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Syntax_Print.showable_term) pat_bv_tms in FStar_Compiler_Util.print3 - "tc_eqn: typechecked pattern %s with bvs %s and pat_bv_tms %s\n" + "tc_eqn: typechecked pattern %s with bvs %s and pat_bv_tms=%s\n" uu___8 uu___9 uu___10 else ()); (let uu___7 = @@ -9354,7 +9475,8 @@ and (tc_eqn : FStar_Compiler_Range_Ops.string_of_range pat_exp1.FStar_Syntax_Syntax.pos in let uu___15 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term pat_exp1 in let uu___16 = FStar_Syntax_Print.tag_of_term @@ -9385,7 +9507,8 @@ and (tc_eqn : FStar_Compiler_Range_Ops.string_of_range pattern2.FStar_Syntax_Syntax.p in let uu___15 = - FStar_Syntax_Print.pat_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_pat pattern2 in FStar_Compiler_Util.format2 "Impossible (%s): scrutinee of match is not defined %s" @@ -9621,10 +9744,12 @@ and (tc_eqn : | uu___12 -> let uu___13 = let uu___14 = - FStar_Syntax_Print.pat_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_pat pattern2 in let uu___15 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term pat_exp2 in FStar_Compiler_Util.format2 "Internal error: unexpected elaborated pattern: %s and pattern expression %s" @@ -9676,7 +9801,8 @@ and (tc_eqn : if uu___11 then let uu___12 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term branch_guard in FStar_Compiler_Util.print1 "tc_eqn: branch guard : %s\n" @@ -10152,42 +10278,18 @@ and (tc_eqn : then let uu___18 = - FStar_Compiler_List.fold_left - (fun s -> - fun t -> - let uu___19 - = - let uu___20 - = - FStar_Syntax_Print.term_to_string - t in - Prims.strcat - ";" - uu___20 in - Prims.strcat - s uu___19) - "" + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Syntax_Print.showable_term) pat_bv_tms2 in let uu___19 = - FStar_Compiler_List.fold_left - (fun s -> - fun t -> - let uu___20 - = - let uu___21 - = - FStar_Syntax_Print.bv_to_string - t in - Prims.strcat - ";" - uu___21 in - Prims.strcat - s uu___20) - "" + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Syntax_Print.showable_bv) pat_bvs in FStar_Compiler_Util.print2 - "tc_eqn: typechecked pat_bv_tms %s (pat_bvs : %s)\n" + "tc_eqn: typechecked pat_bv_tms=%s (pat_bvs=%s)\n" uu___18 uu___19 else ()); @@ -10390,7 +10492,8 @@ and (check_top_level_let : if uu___4 then let uu___5 = - FStar_Syntax_Print.term_to_string e11 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e11 in FStar_Compiler_Util.print1 "Let binding BEFORE tcnorm: %s\n" uu___5 else ()); @@ -10413,7 +10516,8 @@ and (check_top_level_let : if uu___5 then let uu___6 = - FStar_Syntax_Print.term_to_string e12 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e12 in FStar_Compiler_Util.print1 "Let binding AFTER tcnorm: %s\n" uu___6 else ()); @@ -10615,9 +10719,11 @@ and (check_inner_let : then let uu___4 = let uu___5 = - let uu___6 = FStar_Syntax_Print.term_to_string e1 in + let uu___6 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e1 in let uu___7 = - FStar_Syntax_Print.lid_to_string + FStar_Class_Show.show FStar_Ident.showable_lident c1.FStar_TypeChecker_Common.eff_name in FStar_Compiler_Util.format2 "Definitions marked @inline_let are expected to be pure or ghost; got an expression \"%s\" with effect \"%s\"" @@ -10746,9 +10852,11 @@ and (check_inner_let : if uu___7 then let uu___8 = - FStar_Syntax_Print.term_to_string tt in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term tt in let uu___9 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term cres.FStar_TypeChecker_Common.res_typ in FStar_Compiler_Util.print2 "Got expected type from env %s\ncres.res_typ=%s\n" @@ -10768,10 +10876,12 @@ and (check_inner_let : if uu___9 then let uu___10 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term cres.FStar_TypeChecker_Common.res_typ in let uu___11 = - FStar_Syntax_Print.term_to_string t in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in FStar_Compiler_Util.print2 "Checked %s has no escaping types; normalized to %s\n" uu___10 uu___11 @@ -11211,9 +11321,11 @@ and (build_let_rec_env : let uu___7 = FStar_Syntax_Print.tag_of_term lbdef in let uu___8 = - FStar_Syntax_Print.term_to_string lbdef in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term lbdef in let uu___9 = - FStar_Syntax_Print.term_to_string lbtyp in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term lbtyp in FStar_Compiler_Util.format3 "Only function literals with arrow types can be defined recursively; got (%s) %s : %s" uu___7 uu___8 uu___9 in @@ -11231,7 +11343,10 @@ and (build_let_rec_env : ((let uu___7 = let uu___8 = let uu___9 = - FStar_Syntax_Print.lbname_to_string lbname in + FStar_Class_Show.show + (FStar_Class_Show.show_either + FStar_Syntax_Print.showable_bv + FStar_Syntax_Print.showable_fv) lbname in Prims.strcat "Admitting termination of " uu___9 in (FStar_Errors_Codes.Warning_WarnOnUse, uu___8) in @@ -11412,7 +11527,8 @@ and (build_let_rec_env : FStar_Compiler_Util.string_of_int arity in let uu___9 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term lbdef1 in FStar_Compiler_Util.print2 "termination_check_enabled returned arity: %s and lbdef: %s\n" @@ -11614,10 +11730,14 @@ and (check_let_recs : let uu___3 = let uu___4 = let uu___5 = - FStar_Syntax_Print.lbname_to_string + FStar_Class_Show.show + (FStar_Class_Show.show_either + FStar_Syntax_Print.showable_bv + FStar_Syntax_Print.showable_fv) lb.FStar_Syntax_Syntax.lbname in let uu___6 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term lb.FStar_Syntax_Syntax.lbdef in FStar_Compiler_Util.format2 "Only function literals may be defined recursively; %s is defined to be %s" @@ -11864,7 +11984,10 @@ and (check_let_bound_def : if uu___7 then let uu___8 = - FStar_Syntax_Print.lbname_to_string + FStar_Class_Show.show + (FStar_Class_Show.show_either + FStar_Syntax_Print.showable_bv + FStar_Syntax_Print.showable_fv) lb.FStar_Syntax_Syntax.lbname in let uu___9 = FStar_TypeChecker_Common.lcomp_to_string @@ -11944,7 +12067,8 @@ and (check_lbtyp : FStar_Compiler_Range_Ops.string_of_range uu___11 in let uu___11 = - FStar_Syntax_Print.term_to_string t2 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t2 in FStar_Compiler_Util.print2 "(%s) Checked type annotation %s\n" uu___10 uu___11 @@ -11974,11 +12098,14 @@ and (tc_binder : ((let uu___3 = FStar_Compiler_Debug.extreme () in if uu___3 then - let uu___4 = FStar_Syntax_Print.bv_to_string x in + let uu___4 = + FStar_Class_Show.show FStar_Syntax_Print.showable_bv x in let uu___5 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show FStar_Syntax_Print.showable_term x.FStar_Syntax_Syntax.sort in - let uu___6 = FStar_Syntax_Print.term_to_string tu in + let uu___6 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term + tu in FStar_Compiler_Util.print3 "Checking binder %s:%s at type %s\n" uu___4 uu___5 uu___6 @@ -12021,10 +12148,12 @@ and (tc_binder : if uu___9 then let uu___10 = - FStar_Syntax_Print.bv_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv x1.FStar_Syntax_Syntax.binder_bv in let uu___11 = - FStar_Syntax_Print.term_to_string t in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in FStar_Compiler_Util.print2 "Pushing binder %s at type %s\n" uu___10 uu___11 @@ -12253,7 +12382,8 @@ let (typeof_tot_or_gtot_term : (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_RelCheck in if uu___1 then - let uu___2 = FStar_Syntax_Print.term_to_string e in + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term e in FStar_Compiler_Util.print1 "Checking term %s\n" uu___2 else ()); (let env1 = @@ -12380,7 +12510,9 @@ let (typeof_tot_or_gtot_term : else (let uu___4 = let uu___5 = - let uu___6 = FStar_Syntax_Print.term_to_string e in + let uu___6 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e in FStar_Compiler_Util.format1 "Implicit argument: Expected a total term; got a ghost term: %s" uu___6 in @@ -12401,7 +12533,8 @@ let level_of_type_fail : let uu___1 = let uu___2 = let uu___3 = - let uu___4 = FStar_Syntax_Print.term_to_string e in + let uu___4 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term e in FStar_Compiler_Util.format2 "Expected a type; got %s of type %s" uu___4 t in FStar_Errors_Msg.text uu___3 in @@ -12545,7 +12678,9 @@ let (level_of_type : let g = FStar_TypeChecker_Rel.teq env1 t1 t_u in ((match g.FStar_TypeChecker_Common.guard_f with | FStar_TypeChecker_Common.NonTrivial f -> - let uu___5 = FStar_Syntax_Print.term_to_string t1 in + let uu___5 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t1 in level_of_type_fail env1 e uu___5 | uu___5 -> FStar_TypeChecker_Rel.force_trivial_guard env1 g); @@ -12636,19 +12771,22 @@ let rec (universe_of_aux : match uu___ with | FStar_Syntax_Syntax.Tm_bvar uu___1 -> let uu___2 = - let uu___3 = FStar_Syntax_Print.term_to_string e in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term e in Prims.strcat "TcTerm.universe_of:Impossible (bvar/unknown/lazy) " uu___3 in FStar_Compiler_Effect.failwith uu___2 | FStar_Syntax_Syntax.Tm_unknown -> let uu___1 = - let uu___2 = FStar_Syntax_Print.term_to_string e in + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term e in Prims.strcat "TcTerm.universe_of:Impossible (bvar/unknown/lazy) " uu___2 in FStar_Compiler_Effect.failwith uu___1 | FStar_Syntax_Syntax.Tm_delayed uu___1 -> let uu___2 = - let uu___3 = FStar_Syntax_Print.term_to_string e in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term e in Prims.strcat "TcTerm.universe_of:Impossible (bvar/unknown/lazy) " uu___3 in FStar_Compiler_Effect.failwith uu___2 @@ -12729,11 +12867,14 @@ let rec (universe_of_aux : let uu___9 = let uu___10 = let uu___11 = - FStar_Syntax_Print.fv_to_string fv in + FStar_Class_Show.show + FStar_Syntax_Print.showable_fv fv in let uu___12 = - FStar_Syntax_Print.univ_to_string ul in + FStar_Class_Show.show + FStar_Syntax_Print.showable_univ ul in let uu___13 = - FStar_Syntax_Print.univ_to_string ur in + FStar_Class_Show.show + FStar_Syntax_Print.showable_univ ur in FStar_Compiler_Util.format3 "Incompatible universe application for %s, expected %s got %s\n" uu___11 uu___12 uu___13 in @@ -12954,7 +13095,9 @@ let rec (universe_of_aux : let uu___6 = let uu___7 = FStar_TypeChecker_Env.get_range env3 in FStar_Compiler_Range_Ops.string_of_range uu___7 in - let uu___7 = FStar_Syntax_Print.term_to_string hd2 in + let uu___7 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term hd2 in FStar_Compiler_Util.print2 "%s: About to type-check %s\n" uu___6 uu___7 else ()); @@ -12978,7 +13121,9 @@ let rec (universe_of_aux : (match uu___2 with | FStar_Pervasives_Native.Some t1 -> t1 | FStar_Pervasives_Native.None -> - let uu___3 = FStar_Syntax_Print.term_to_string t in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term + t in level_of_type_fail env e uu___3)) | FStar_Syntax_Syntax.Tm_match { FStar_Syntax_Syntax.scrutinee = uu___1; @@ -13009,7 +13154,8 @@ let (universe_of : (let uu___2 = FStar_Compiler_Debug.high () in if uu___2 then - let uu___3 = FStar_Syntax_Print.term_to_string e in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term e in FStar_Compiler_Util.print1 "Calling universe_of_aux with %s {\n" uu___3 else ()); @@ -13021,7 +13167,8 @@ let (universe_of : (let uu___4 = FStar_Compiler_Debug.high () in if uu___4 then - let uu___5 = FStar_Syntax_Print.term_to_string r in + let uu___5 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term r in FStar_Compiler_Util.print1 "Got result from universe_of_aux = %s }\n" uu___5 else ()); @@ -13056,12 +13203,14 @@ let rec (__typeof_tot_or_gtot_term_fastpath : match t1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_delayed uu___ -> let uu___1 = - let uu___2 = FStar_Syntax_Print.term_to_string t1 in + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t1 in Prims.strcat "Impossible: " uu___2 in FStar_Compiler_Effect.failwith uu___1 | FStar_Syntax_Syntax.Tm_bvar uu___ -> let uu___1 = - let uu___2 = FStar_Syntax_Print.term_to_string t1 in + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t1 in Prims.strcat "Impossible: " uu___2 in FStar_Compiler_Effect.failwith uu___1 | FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_reify uu___) -> From 9d61fdd3b8dd46ea7795473fa95977865981028a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 13 May 2024 05:00:50 -0700 Subject: [PATCH 179/239] Add repros for #3264 --- tests/bug-reports/Bug3264a.fst | 20 ++++++++++++++++++++ tests/bug-reports/Bug3264b.fst | 15 +++++++++++++++ tests/bug-reports/Makefile | 3 ++- 3 files changed, 37 insertions(+), 1 deletion(-) create mode 100644 tests/bug-reports/Bug3264a.fst create mode 100644 tests/bug-reports/Bug3264b.fst diff --git a/tests/bug-reports/Bug3264a.fst b/tests/bug-reports/Bug3264a.fst new file mode 100644 index 00000000000..c738bebfd8a --- /dev/null +++ b/tests/bug-reports/Bug3264a.fst @@ -0,0 +1,20 @@ +module Bug3264a + +class class_a (t: Type0): Type u#1 = { + type_a: Type0; + f_a: t -> type_a +} +class class_b (t: Type0): Type u#1 = { + super_a: class_a t; + f_b: t -> super_a.type_a +} + +instance foo1 (t: Type) {| i: class_a t |}: class_b t = { + super_a = FStar.Tactics.Typeclasses.solve; + f_b = (fun (y: t) -> f_a y) +} + +instance foo2 (t: Type) {| i: class_a t |}: class_b t = { + super_a = (_ by (FStar.Tactics.Typeclasses.tcresolve ())); + f_b = (fun (y: t) -> f_a y) +} diff --git a/tests/bug-reports/Bug3264b.fst b/tests/bug-reports/Bug3264b.fst new file mode 100644 index 00000000000..bc6ce7c33f1 --- /dev/null +++ b/tests/bug-reports/Bug3264b.fst @@ -0,0 +1,15 @@ +module Bug3264b + +class class_a (t: Type0): Type u#1 = { + type_a: Type0; + f_a: t -> type_a +} +class class_b (t: Type0): Type u#1 = { + super_a: class_a t; + f_b: t -> super_a.type_a +} + +instance foo1 (t: Type) {| i: class_a t |}: class_b t = { + super_a = FStar.Tactics.Typeclasses.solve; + f_b = magic() +} diff --git a/tests/bug-reports/Makefile b/tests/bug-reports/Makefile index 77dd01b9a70..7728449aa22 100644 --- a/tests/bug-reports/Makefile +++ b/tests/bug-reports/Makefile @@ -78,7 +78,8 @@ SHOULD_VERIFY_CLOSED=\ Bug3120a.fst Bug3120b.fst Bug3186.fst Bug3185.fst Bug3210.fst \ Bug3213.fst Bug3213b.fst Bug3207.fst Bug3207b.fst Bug3207c.fst \ Bug2155.fst Bug3224a.fst Bug3224b.fst Bug3236.fst Bug3252.fst \ - BugBoxInjectivity.fst BugTypeParamProjector.fst Bug2172.fst Bug3266.fst + BugBoxInjectivity.fst BugTypeParamProjector.fst Bug2172.fst Bug3266.fst \ + Bug3264a.fst Bug3264b.fst SHOULD_VERIFY_INTERFACE_CLOSED=Bug771.fsti Bug771b.fsti SHOULD_VERIFY_AND_WARN_CLOSED=Bug016.fst From aa2c5f3cf1fc9364aad8ee1a77c567d7013c27cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 13 May 2024 14:35:53 -0700 Subject: [PATCH 180/239] SMTEncoding: format error --- src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst b/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst index 9a2895231ee..2bb8b91d479 100644 --- a/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst +++ b/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst @@ -1264,10 +1264,15 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t begin match lopt with | None -> + let open FStar.Class.PP in + let open FStar.Pprint in + let open FStar.Errors.Msg in //we don't even know if this is a pure function, so give up - Errors.log_issue t0.pos (Errors.Warning_FunctionLiteralPrecisionLoss, (BU.format1 - "Losing precision when encoding a function literal: %s\n\ - (Unnannotated abstraction in the compiler ?)" (Print.term_to_string t0))); + Errors.log_issue_doc t0.pos (Errors.Warning_FunctionLiteralPrecisionLoss, [ + prefix 2 1 (text "Losing precision when encoding a function literal:") + (pp t0); + text "Unannotated abstraction in the compiler?" + ]); fallback () | Some rc -> From 255a0cfd806fb9b2a15353cb88f6b60af88130a0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 13 May 2024 15:04:28 -0700 Subject: [PATCH 181/239] Parser.Dep: format error --- src/parser/FStar.Parser.Dep.fst | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) diff --git a/src/parser/FStar.Parser.Dep.fst b/src/parser/FStar.Parser.Dep.fst index 8e1b65292f0..34b61a34ca1 100644 --- a/src/parser/FStar.Parser.Dep.fst +++ b/src/parser/FStar.Parser.Dep.fst @@ -555,18 +555,18 @@ let dep_subsumed_by d d' = let enter_namespace (original_map: files_for_module_name) (working_map: files_for_module_name) - (prefix: string) + (sprefix: string) (implicit_open:bool) : bool = let found = BU.mk_ref false in - let prefix = prefix ^ "." in + let sprefix = sprefix ^ "." in let suffix_exists mopt = match mopt with | None -> false | Some (intf, impl) -> is_some intf || is_some impl in smap_iter original_map (fun k _ -> - if Util.starts_with k prefix then + if Util.starts_with k sprefix then let suffix = - String.substring k (String.length prefix) (String.length k - String.length prefix) + String.substring k (String.length sprefix) (String.length k - String.length sprefix) in begin @@ -574,11 +574,19 @@ let enter_namespace if implicit_open && suffix_exists suffix_filename then let str = suffix_filename |> must |> intf_and_impl_to_string in - FStar.Errors.log_issue_doc Range.dummyRange - (Errors.Warning_UnexpectedFile, - [Errors.text <| - BU.format4 "Implicitly opening %s namespace shadows (%s -> %s), rename %s to \ - avoid conflicts" prefix suffix str str]) + let open FStar.Pprint in + log_issue_doc Range.dummyRange + (Errors.Warning_UnexpectedFile, [ + flow (break_ 1) [ + text "Implicitly opening namespace"; + squotes (doc_of_string sprefix); + text "shadows module"; + squotes (doc_of_string suffix); + text "in file"; + dquotes (doc_of_string str) ^^ dot; + ]; + text "Rename" ^/^ dquotes (doc_of_string str) ^/^ text "to avoid conflicts."; + ]) end; let filename = must (smap_try_find original_map k) in @@ -682,7 +690,7 @@ let collect_one end in - let record_open_namespace lid (implicit_open:bool) = + let record_open_namespace lid (implicit_open:bool) = let key = lowercase_join_longident lid true in let r = enter_namespace original_map working_map key implicit_open in if not r && not implicit_open then //suppress the warning for implicit opens From f6dfcc74b8cabd74ca2740cb48701a417b6964fc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 13 May 2024 15:20:01 -0700 Subject: [PATCH 182/239] Fix error message --- src/extraction/FStar.Extraction.ML.Term.fst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/extraction/FStar.Extraction.ML.Term.fst b/src/extraction/FStar.Extraction.ML.Term.fst index 8a5c0699307..ebc0a728662 100644 --- a/src/extraction/FStar.Extraction.ML.Term.fst +++ b/src/extraction/FStar.Extraction.ML.Term.fst @@ -107,7 +107,7 @@ let err_unexpected_eff env t ty f0 f1 = prefix 4 1 (text "For expression") (Print.term_to_doc t) ^/^ prefix 4 1 (text "of type") (arbitrary_string (Code.string_of_mlty (current_module_of_uenv env) ty)); prefix 4 1 (text "Expected effect") (arbitrary_string (eff_to_string f0)) ^/^ - prefix 4 1 (text "got effect") (arbitrary_string (eff_to_string f0))]) + prefix 4 1 (text "got effect") (arbitrary_string (eff_to_string f1))]) let err_cannot_extract_effect (l:lident) (r:Range.range) (reason:string) (ctxt:string) = Errors.raise_error_doc From 2baf91bc05eb489d69b89e50c84e878b193f3593 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 13 May 2024 15:05:42 -0700 Subject: [PATCH 183/239] snap --- .../generated/FStar_Extraction_ML_Term.ml | 14 ++-- ocaml/fstar-lib/generated/FStar_Parser_Dep.ml | 68 ++++++++++++++++--- .../generated/FStar_SMTEncoding_EncodeTerm.ml | 21 ++++-- 3 files changed, 80 insertions(+), 23 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Extraction_ML_Term.ml b/ocaml/fstar-lib/generated/FStar_Extraction_ML_Term.ml index fc86e1b84f5..a955c69dd6f 100644 --- a/ocaml/fstar-lib/generated/FStar_Extraction_ML_Term.ml +++ b/ocaml/fstar-lib/generated/FStar_Extraction_ML_Term.ml @@ -112,12 +112,12 @@ let err_value_restriction : uu___2 uu___3 in (FStar_Errors_Codes.Fatal_ValueRestriction, uu___1) in fail t.FStar_Syntax_Syntax.pos uu___ -let err_unexpected_eff : - 'uuuuu . - FStar_Extraction_ML_UEnv.uenv -> - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> - FStar_Extraction_ML_Syntax.mlty -> - FStar_Extraction_ML_Syntax.e_tag -> 'uuuuu -> unit +let (err_unexpected_eff : + FStar_Extraction_ML_UEnv.uenv -> + FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> + FStar_Extraction_ML_Syntax.mlty -> + FStar_Extraction_ML_Syntax.e_tag -> + FStar_Extraction_ML_Syntax.e_tag -> unit) = fun env -> fun t -> @@ -157,7 +157,7 @@ let err_unexpected_eff : let uu___7 = FStar_Errors_Msg.text "got effect" in let uu___8 = let uu___9 = - FStar_Extraction_ML_Util.eff_to_string f0 in + FStar_Extraction_ML_Util.eff_to_string f1 in FStar_Pprint.arbitrary_string uu___9 in FStar_Pprint.prefix (Prims.of_int (4)) Prims.int_one uu___7 uu___8 in diff --git a/ocaml/fstar-lib/generated/FStar_Parser_Dep.ml b/ocaml/fstar-lib/generated/FStar_Parser_Dep.ml index c9bfb9368c5..537ba47d770 100644 --- a/ocaml/fstar-lib/generated/FStar_Parser_Dep.ml +++ b/ocaml/fstar-lib/generated/FStar_Parser_Dep.ml @@ -935,10 +935,10 @@ let (enter_namespace : = fun original_map -> fun working_map -> - fun prefix -> + fun sprefix -> fun implicit_open -> let found = FStar_Compiler_Util.mk_ref false in - let prefix1 = Prims.strcat prefix "." in + let sprefix1 = Prims.strcat sprefix "." in let suffix_exists mopt = match mopt with | FStar_Pervasives_Native.None -> false @@ -948,13 +948,13 @@ let (enter_namespace : FStar_Compiler_Util.smap_iter original_map (fun k -> fun uu___1 -> - if FStar_Compiler_Util.starts_with k prefix1 + if FStar_Compiler_Util.starts_with k sprefix1 then let suffix = FStar_Compiler_String.substring k - (FStar_Compiler_String.length prefix1) + (FStar_Compiler_String.length sprefix1) ((FStar_Compiler_String.length k) - - (FStar_Compiler_String.length prefix1)) in + (FStar_Compiler_String.length sprefix1)) in ((let suffix_filename = FStar_Compiler_Util.smap_try_find original_map suffix in if implicit_open && (suffix_exists suffix_filename) @@ -966,12 +966,58 @@ let (enter_namespace : let uu___3 = let uu___4 = let uu___5 = - let uu___6 = - FStar_Compiler_Util.format4 - "Implicitly opening %s namespace shadows (%s -> %s), rename %s to avoid conflicts" - prefix1 suffix str str in - FStar_Errors_Msg.text uu___6 in - [uu___5] in + let uu___6 = FStar_Pprint.break_ Prims.int_one in + let uu___7 = + let uu___8 = + FStar_Errors_Msg.text + "Implicitly opening namespace" in + let uu___9 = + let uu___10 = + let uu___11 = + FStar_Pprint.doc_of_string sprefix1 in + FStar_Pprint.squotes uu___11 in + let uu___11 = + let uu___12 = + FStar_Errors_Msg.text "shadows module" in + let uu___13 = + let uu___14 = + let uu___15 = + FStar_Pprint.doc_of_string suffix in + FStar_Pprint.squotes uu___15 in + let uu___15 = + let uu___16 = + FStar_Errors_Msg.text "in file" in + let uu___17 = + let uu___18 = + let uu___19 = + let uu___20 = + FStar_Pprint.doc_of_string str in + FStar_Pprint.dquotes uu___20 in + FStar_Pprint.op_Hat_Hat uu___19 + FStar_Pprint.dot in + [uu___18] in + uu___16 :: uu___17 in + uu___14 :: uu___15 in + uu___12 :: uu___13 in + uu___10 :: uu___11 in + uu___8 :: uu___9 in + FStar_Pprint.flow uu___6 uu___7 in + let uu___6 = + let uu___7 = + let uu___8 = FStar_Errors_Msg.text "Rename" in + let uu___9 = + let uu___10 = + let uu___11 = + FStar_Pprint.doc_of_string str in + FStar_Pprint.dquotes uu___11 in + let uu___11 = + FStar_Errors_Msg.text + "to avoid conflicts." in + FStar_Pprint.op_Hat_Slash_Hat uu___10 + uu___11 in + FStar_Pprint.op_Hat_Slash_Hat uu___8 uu___9 in + [uu___7] in + uu___5 :: uu___6 in (FStar_Errors_Codes.Warning_UnexpectedFile, uu___4) in FStar_Errors.log_issue_doc FStar_Compiler_Range_Type.dummyRange uu___3 diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml index 2d68dbf5345..309139e16a9 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml @@ -2730,13 +2730,24 @@ and (encode_term : | FStar_Pervasives_Native.None -> ((let uu___4 = let uu___5 = - let uu___6 = FStar_Syntax_Print.term_to_string t0 in - FStar_Compiler_Util.format1 - "Losing precision when encoding a function literal: %s\n(Unnannotated abstraction in the compiler ?)" - uu___6 in + let uu___6 = + let uu___7 = + FStar_Errors_Msg.text + "Losing precision when encoding a function literal:" in + let uu___8 = + FStar_Class_PP.pp + FStar_Syntax_Print.pretty_term t0 in + FStar_Pprint.prefix (Prims.of_int (2)) + Prims.int_one uu___7 uu___8 in + let uu___7 = + let uu___8 = + FStar_Errors_Msg.text + "Unannotated abstraction in the compiler?" in + [uu___8] in + uu___6 :: uu___7 in (FStar_Errors_Codes.Warning_FunctionLiteralPrecisionLoss, uu___5) in - FStar_Errors.log_issue t0.FStar_Syntax_Syntax.pos + FStar_Errors.log_issue_doc t0.FStar_Syntax_Syntax.pos uu___4); fallback ()) | FStar_Pervasives_Native.Some rc -> From 5610383a65e56c818db9f9d011954c6b99efffe9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 3 May 2024 11:47:02 -0700 Subject: [PATCH 184/239] SizeT: make SizeT.t a `new` type This allows to fail faster (without SMT) when we mistakenly use a SizeT where an int is needed, and similar errors. --- ulib/FStar.PtrdiffT.fst | 2 +- ulib/FStar.SizeT.fst | 33 +++++++++++++++++---------------- ulib/FStar.SizeT.fsti | 1 + 3 files changed, 19 insertions(+), 17 deletions(-) diff --git a/ulib/FStar.PtrdiffT.fst b/ulib/FStar.PtrdiffT.fst index 46252ed167c..e589a04bb3a 100644 --- a/ulib/FStar.PtrdiffT.fst +++ b/ulib/FStar.PtrdiffT.fst @@ -41,7 +41,7 @@ let mk x = int_to_t (I16.v x) let ptrdifft_to_sizet x = bounds_lemma (); - Cast.int64_to_uint64 x + SizeT.Sz <| Cast.int64_to_uint64 x let add x y = I64.add x y diff --git a/ulib/FStar.SizeT.fst b/ulib/FStar.SizeT.fst index da45639bb15..cdee6e367b4 100644 --- a/ulib/FStar.SizeT.fst +++ b/ulib/FStar.SizeT.fst @@ -10,7 +10,7 @@ module I64 = FStar.Int64 assume val bound : x:erased nat { x >= pow2 16 } -let t = x:U64.t { U64.v x < bound } +type t : eqtype = | Sz : (x:U64.t { U64.v x < bound }) -> t let fits x = FStar.UInt.fits x U64.n == true /\ @@ -19,11 +19,11 @@ let fits x = let fits_at_least_16 _ = () let v x = - U64.v x + U64.v (Sz?.x x) irreducible let uint_to_t x = - U64.uint_to_t x + Sz (U64.uint_to_t x) let size_v_inj (x: t) = () let size_uint_to_t_inj (x: nat) = () @@ -62,22 +62,23 @@ let of_u64 (x: U64.t) let uint16_to_sizet x = uint_to_t (U16.v x) let uint32_to_sizet x = uint_to_t (U32.v x) let uint64_to_sizet x = uint_to_t (U64.v x) -let sizet_to_uint32 x = FStar.Int.Cast.uint64_to_uint32 x +let sizet_to_uint32 x = FStar.Int.Cast.uint64_to_uint32 (Sz?.x x) let fits_lte x y = () #push-options "--z3rlimit 20" -let add x y = U64.add x y -let sub x y = U64.sub x y -let mul x y = U64.mul x y +let add x y = Sz <| U64.add x.x y.x +let sub x y = Sz <| U64.sub x.x y.x +let mul x y = Sz <| U64.mul x.x y.x let div x y = - let res = U64.div x y in - fits_lte (U64.v res) (U64.v x); - FStar.Math.Lib.slash_decr_axiom (U64.v x) (U64.v y); - assert (U64.v x / U64.v y <= U64.v x); + let res = Sz <| U64.div x.x y.x in + fits_lte (U64.v res.x) (U64.v x.x); + FStar.Math.Lib.slash_decr_axiom (U64.v x.x) (U64.v y.x); + assert (U64.v x.x / U64.v y.x <= U64.v x.x); res -let rem x y = U64.rem x y -let gt x y = U64.gt x y -let gte x y = U64.gte x y -let lt x y = U64.lt x y -let lte x y = U64.lte x y + +let rem x y = Sz <| U64.rem x.x y.x +let gt x y = U64.gt x.x y.x +let gte x y = U64.gte x.x y.x +let lt x y = U64.lt x.x y.x +let lte x y = U64.lte x.x y.x diff --git a/ulib/FStar.SizeT.fsti b/ulib/FStar.SizeT.fsti index 6dfb81a44b6..d54f57845ad 100644 --- a/ulib/FStar.SizeT.fsti +++ b/ulib/FStar.SizeT.fsti @@ -6,6 +6,7 @@ module U16 = FStar.UInt16 module U32 = FStar.UInt32 module U64 = FStar.UInt64 +new val t : eqtype val fits (x: nat) : Tot prop From e26f65baf35d32dbf4504b18169706eb36876d30 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 3 May 2024 12:09:33 -0700 Subject: [PATCH 185/239] snap --- ocaml/fstar-lib/generated/FStar_PtrdiffT.ml | 2 +- ocaml/fstar-lib/generated/FStar_SizeT.ml | 54 ++++++++++++++++----- 2 files changed, 42 insertions(+), 14 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_PtrdiffT.ml b/ocaml/fstar-lib/generated/FStar_PtrdiffT.ml index 922174eee30..45945e4417f 100644 --- a/ocaml/fstar-lib/generated/FStar_PtrdiffT.ml +++ b/ocaml/fstar-lib/generated/FStar_PtrdiffT.ml @@ -4,7 +4,7 @@ type 'x fits = unit let (v : t -> Prims.int) = fun x -> FStar_Int64.v x let (int_to_t : Prims.int -> t) = fun x -> FStar_Int64.int_to_t x let (ptrdifft_to_sizet : t -> FStar_SizeT.t) = - fun x -> FStar_Int_Cast.int64_to_uint64 x + fun x -> FStar_SizeT.Sz (FStar_Int_Cast.int64_to_uint64 x) let (add : t -> t -> t) = fun x -> fun y -> FStar_Int64.add x y let (div : t -> t -> t) = fun x -> fun y -> FStar_Int64.div x y let (rem : t -> t -> t) = fun x -> fun y -> FStar_Int64.rem x y diff --git a/ocaml/fstar-lib/generated/FStar_SizeT.ml b/ocaml/fstar-lib/generated/FStar_SizeT.ml index 4ff294e6f2b..5c70c2fe7ce 100644 --- a/ocaml/fstar-lib/generated/FStar_SizeT.ml +++ b/ocaml/fstar-lib/generated/FStar_SizeT.ml @@ -1,8 +1,12 @@ open Prims -type t = FStar_UInt64.t +type t = + | Sz of FStar_UInt64.t +let (uu___is_Sz : t -> Prims.bool) = fun projectee -> true +let (__proj__Sz__item__x : t -> FStar_UInt64.t) = + fun projectee -> match projectee with | Sz x -> x type 'x fits = unit -let (v : t -> Prims.nat) = fun x -> FStar_UInt64.v x -let (uint_to_t : Prims.nat -> t) = fun x -> FStar_UInt64.uint_to_t x +let (v : t -> Prims.nat) = fun x -> FStar_UInt64.v (__proj__Sz__item__x x) +let (uint_to_t : Prims.nat -> t) = fun x -> Sz (FStar_UInt64.uint_to_t x) type fits_u32 = unit type fits_u64 = unit let (uint16_to_sizet : FStar_UInt16.t -> t) = @@ -12,17 +16,41 @@ let (uint32_to_sizet : FStar_UInt32.t -> t) = let (uint64_to_sizet : FStar_UInt64.t -> t) = fun x -> uint_to_t (FStar_UInt64.v x) let (sizet_to_uint32 : t -> FStar_UInt32.t) = - fun x -> FStar_Int_Cast.uint64_to_uint32 x -let (add : t -> t -> t) = fun x -> fun y -> FStar_UInt64.add x y -let (sub : t -> t -> t) = fun x -> fun y -> FStar_UInt64.sub x y -let (mul : t -> t -> t) = fun x -> fun y -> FStar_UInt64.mul x y + fun x -> FStar_Int_Cast.uint64_to_uint32 (__proj__Sz__item__x x) +let (add : t -> t -> t) = + fun x -> + fun y -> + Sz (FStar_UInt64.add (__proj__Sz__item__x x) (__proj__Sz__item__x y)) +let (sub : t -> t -> t) = + fun x -> + fun y -> + Sz (FStar_UInt64.sub (__proj__Sz__item__x x) (__proj__Sz__item__x y)) +let (mul : t -> t -> t) = + fun x -> + fun y -> + Sz (FStar_UInt64.mul (__proj__Sz__item__x x) (__proj__Sz__item__x y)) let (div : t -> t -> t) = - fun x -> fun y -> let res = FStar_UInt64.div x y in res -let (rem : t -> t -> t) = fun x -> fun y -> FStar_UInt64.rem x y -let (gt : t -> t -> Prims.bool) = fun x -> fun y -> FStar_UInt64.gt x y -let (gte : t -> t -> Prims.bool) = fun x -> fun y -> FStar_UInt64.gte x y -let (lt : t -> t -> Prims.bool) = fun x -> fun y -> FStar_UInt64.lt x y -let (lte : t -> t -> Prims.bool) = fun x -> fun y -> FStar_UInt64.lte x y + fun x -> + fun y -> + let res = + Sz (FStar_UInt64.div (__proj__Sz__item__x x) (__proj__Sz__item__x y)) in + res +let (rem : t -> t -> t) = + fun x -> + fun y -> + Sz (FStar_UInt64.rem (__proj__Sz__item__x x) (__proj__Sz__item__x y)) +let (gt : t -> t -> Prims.bool) = + fun x -> + fun y -> FStar_UInt64.gt (__proj__Sz__item__x x) (__proj__Sz__item__x y) +let (gte : t -> t -> Prims.bool) = + fun x -> + fun y -> FStar_UInt64.gte (__proj__Sz__item__x x) (__proj__Sz__item__x y) +let (lt : t -> t -> Prims.bool) = + fun x -> + fun y -> FStar_UInt64.lt (__proj__Sz__item__x x) (__proj__Sz__item__x y) +let (lte : t -> t -> Prims.bool) = + fun x -> + fun y -> FStar_UInt64.lte (__proj__Sz__item__x x) (__proj__Sz__item__x y) let (op_Plus_Hat : t -> t -> t) = add let (op_Subtraction_Hat : t -> t -> t) = sub let (op_Star_Hat : t -> t -> t) = mul From 277ba7ce2ab69876840ebf4ca9d36815dcbbbf45 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Tue, 14 May 2024 15:27:23 -0700 Subject: [PATCH 186/239] Errors: do not indent IDE errors components --- src/basic/FStar.Errors.Msg.fst | 6 ++++-- src/basic/FStar.Errors.Msg.fsti | 3 +++ src/basic/FStar.Errors.fst | 3 +++ 3 files changed, 10 insertions(+), 2 deletions(-) diff --git a/src/basic/FStar.Errors.Msg.fst b/src/basic/FStar.Errors.Msg.fst index 230b36cda20..f7dd92e0c19 100644 --- a/src/basic/FStar.Errors.Msg.fst +++ b/src/basic/FStar.Errors.Msg.fst @@ -33,7 +33,7 @@ let backtrace_doc () : document = text "Stack trace:" ^/^ arbitrary_string (trim_string s) -let subdoc d = +let subdoc' (indent:bool) d = (* NOTE: slight hack here, using equality on Pprint documents. This works fine, particularly for this case, since empty is just a constructor Empty. There is even a new function to check if a document is empty, added two weeks ago! @@ -42,7 +42,9 @@ let subdoc d = switch to using that function. (I won't right now as it is not released). *) if d = empty then empty - else blank 2 ^^ doc_of_string "-" ^^ blank 1 ^^ align d ^^ hardline + else (if indent then blank 2 else empty) ^^ doc_of_string "-" ^^ blank 1 ^^ align d ^^ hardline + +let subdoc d = subdoc' true d let rendermsg (ds : list document) : string = renderdoc (concat (List.map (fun d -> subdoc (group d)) ds)) diff --git a/src/basic/FStar.Errors.Msg.fsti b/src/basic/FStar.Errors.Msg.fsti index 50a945cafe5..984c94a4fe3 100644 --- a/src/basic/FStar.Errors.Msg.fsti +++ b/src/basic/FStar.Errors.Msg.fsti @@ -41,6 +41,9 @@ one, but if that's the case it's probably better to build a doc instead of lifting from a string. NB: mkmsg s is equal to [doc_of_string s]. *) val mkmsg : string -> error_message +(* As subdoc, but allows to not indent. *) +val subdoc' : indent:bool -> document -> document + (* A nested document that can be concatenated with another one *) val subdoc : document -> document diff --git a/src/basic/FStar.Errors.fst b/src/basic/FStar.Errors.fst index 4368fc263fb..c5757bd7162 100644 --- a/src/basic/FStar.Errors.fst +++ b/src/basic/FStar.Errors.fst @@ -183,6 +183,9 @@ let format_issue' (print_hdr:bool) (issue:issue) : string = List.fold_left (fun l r -> l ^^ hardline ^^ d1 r) (d1 h) t | _ -> empty in + (* We only indent if we are are printing the header. I.e., only ident for batch errors, + not for VS code diagnostics window. *) + let subdoc = subdoc' print_hdr in let mainmsg : document = concat (List.map (fun d -> subdoc (group d)) issue.issue_msg) in From 7022bb45c10207249ab6b2c48b47e4c20f36ac62 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Tue, 14 May 2024 15:27:38 -0700 Subject: [PATCH 187/239] Format some errors --- src/typechecker/FStar.TypeChecker.Err.fst | 34 +++++++++----------- src/typechecker/FStar.TypeChecker.TcTerm.fst | 4 +-- 2 files changed, 17 insertions(+), 21 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.Err.fst b/src/typechecker/FStar.TypeChecker.Err.fst index ccf1a9f1e1c..6f3cbf24e23 100644 --- a/src/typechecker/FStar.TypeChecker.Err.fst +++ b/src/typechecker/FStar.TypeChecker.Err.fst @@ -284,25 +284,21 @@ let computed_computation_type_does_not_match_annotation_eq env e c c' = let unexpected_non_trivial_precondition_on_term env f = (Errors.Fatal_UnExpectedPreCondition, (format1 "Term has an unexpected non-trivial pre-condition: %s" (N.term_to_string env f))) -let expected_pure_expression e c reason = - let msg = "Expected a pure expression" in - let msg = - if reason = "" - then msg - else BU.format1 (msg ^ " (%s)") reason in - (Errors.Fatal_ExpectedPureExpression, - format2 (msg ^ "; got an expression \"%s\" with effect \"%s\"") - (Print.term_to_string e) (fst <| name_and_result c)) - -let expected_ghost_expression e c reason = - let msg = "Expected a ghost expression" in - let msg = - if reason = "" - then msg - else BU.format1 (msg ^ " (%s)") reason in - (Errors.Fatal_ExpectedGhostExpression, - format2 (msg ^ "; got an expression \"%s\" with effect \"%s\"") - (Print.term_to_string e) (fst <| name_and_result c)) +let __expected_eff_expression (effname:string) (e:term) (c:comp) (reason:string) = + let open FStar.Class.PP in + let open FStar.Pprint in + (Errors.Fatal_ExpectedGhostExpression, [ + text ("Expected a " ^ effname ^ " expression."); + (if reason = "" then empty else flow (break_ 1) (doc_of_string "Because:" :: words (reason ^ "."))); + prefix 2 1 (text "Got an expression") (pp e) ^/^ + prefix 2 1 (text "with effect") (squotes (doc_of_string (fst <| name_and_result c))) ^^ dot; + ]) + +let expected_pure_expression (e:term) (c:comp) (reason:string) = + __expected_eff_expression "pure" e c reason + +let expected_ghost_expression (e:term) (c:comp) (reason:string) = + __expected_eff_expression "ghost" e c reason let expected_effect_1_got_effect_2 (c1:lident) (c2:lident) = (Errors.Fatal_UnexpectedEffect, (format2 "Expected a computation with effect %s; but it has effect %s" (Print.lid_to_string c1) (Print.lid_to_string c2))) diff --git a/src/typechecker/FStar.TypeChecker.TcTerm.fst b/src/typechecker/FStar.TypeChecker.TcTerm.fst index ddc580b89fb..54443019a61 100644 --- a/src/typechecker/FStar.TypeChecker.TcTerm.fst +++ b/src/typechecker/FStar.TypeChecker.TcTerm.fst @@ -4491,8 +4491,8 @@ and tc_tot_or_gtot_term_maybe_solve_deferred (env:env) (e:term) (msg:string) (so | Some g' -> e, TcComm.lcomp_of_comp target_comp, Env.conj_guard g (Env.conj_guard g_c g') | _ -> if allow_ghost - then raise_error (Err.expected_ghost_expression e c msg) e.pos - else raise_error (Err.expected_pure_expression e c msg) e.pos + then raise_error_doc (Err.expected_ghost_expression e c msg) e.pos + else raise_error_doc (Err.expected_pure_expression e c msg) e.pos and tc_tot_or_gtot_term' (env:env) (e:term) (msg:string) : term * lcomp * guard_t From b00fe52fce350bebe001fa2db62f126c496876e1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Tue, 14 May 2024 15:40:13 -0700 Subject: [PATCH 188/239] tests/ide: Update expected output --- tests/ide/emacs/Harness.selfref.out.expected | 4 +- ...acking.peek-with-unset-module.out.expected | 2 +- .../backtracking.refinements.out.expected | 42 +++++++++---------- tests/ide/emacs/fstarmode_gh73.out.expected | 8 ++-- .../emacs/integration.push-pop.out.expected | 22 +++++----- ...r.interface-violation-and-fix.out.expected | 2 +- .../number.interface-violation.out.expected | 2 +- tests/ide/emacs/tutorial.push.out.expected | 4 +- 8 files changed, 43 insertions(+), 43 deletions(-) diff --git a/tests/ide/emacs/Harness.selfref.out.expected b/tests/ide/emacs/Harness.selfref.out.expected index 7bb7b9cfd78..08a4b7e237a 100644 --- a/tests/ide/emacs/Harness.selfref.out.expected +++ b/tests/ide/emacs/Harness.selfref.out.expected @@ -1,4 +1,4 @@ {"kind": "protocol-info", "rest": "[...]"} {"kind": "response", "query-id": "1", "response": [], "status": "success"} -{"kind": "response", "query-id": "2", "response": [{"level": "error", "message": " - Could not prove post-condition\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (1,25-1,32)\n", "number": 19, "ranges": [{"beg": [1, 35], "end": [1, 37], "fname": ""}, {"beg": [1, 25], "end": [1, 32], "fname": ""}]}], "status": "failure"} -{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": " - Identifier not found: [Harness.always_foo]\n - Module Harness resolved into Harness, which does not belong to the list of\n modules in scope, namely:\n FStar.Mul, FStar.Classical, FStar.Classical.Sugar, FStar.Pervasives,\n FStar.Pervasives.Native, Prims\n", "number": 72, "ranges": [{"beg": [1, 43], "end": [1, 53], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "2", "response": [{"level": "error", "message": "- Could not prove post-condition\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (1,25-1,32)\n", "number": 19, "ranges": [{"beg": [1, 35], "end": [1, 37], "fname": ""}, {"beg": [1, 25], "end": [1, 32], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": "- Identifier not found: [Harness.always_foo]\n- Module Harness resolved into Harness, which does not belong to the list of\n modules in scope, namely:\n FStar.Mul, FStar.Classical, FStar.Classical.Sugar, FStar.Pervasives,\n FStar.Pervasives.Native, Prims\n", "number": 72, "ranges": [{"beg": [1, 43], "end": [1, 53], "fname": ""}]}], "status": "failure"} diff --git a/tests/ide/emacs/backtracking.peek-with-unset-module.out.expected b/tests/ide/emacs/backtracking.peek-with-unset-module.out.expected index 04e1455285d..7ac9ea6b7d3 100644 --- a/tests/ide/emacs/backtracking.peek-with-unset-module.out.expected +++ b/tests/ide/emacs/backtracking.peek-with-unset-module.out.expected @@ -1,5 +1,5 @@ {"kind": "protocol-info", "rest": "[...]"} -{"kind": "response", "query-id": "1", "response": [{"level": "error", "message": " - Syntax error: expected a module name\n", "number": 168, "ranges": [{"beg": [1, 7], "end": [1, 19], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "1", "response": [{"level": "error", "message": "- Syntax error: expected a module name\n", "number": 168, "ranges": [{"beg": [1, 7], "end": [1, 19], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "2", "response": "Current module unset", "status": "failure"} {"kind": "response", "query-id": "3", "response": "Current module unset", "status": "failure"} {"kind": "response", "query-id": "4", "response": "Current module unset", "status": "failure"} diff --git a/tests/ide/emacs/backtracking.refinements.out.expected b/tests/ide/emacs/backtracking.refinements.out.expected index 6a9f18a6c67..38bff59abc0 100644 --- a/tests/ide/emacs/backtracking.refinements.out.expected +++ b/tests/ide/emacs/backtracking.refinements.out.expected @@ -1,7 +1,7 @@ {"kind": "protocol-info", "rest": "[...]"} {"kind": "response", "query-id": "1", "response": [], "status": "success"} {"kind": "response", "query-id": "2", "response": [], "status": "success"} -{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [3, 6], "end": [3, 6], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [3, 6], "end": [3, 6], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "4", "response": [], "status": "success"} {"kind": "response", "query-id": "5", "response": [], "status": "success"} {"kind": "response", "query-id": "6", "response": [], "status": "success"} @@ -10,40 +10,40 @@ {"kind": "response", "query-id": "9", "response": [], "status": "success"} {"kind": "response", "query-id": "10", "response": [], "status": "success"} {"kind": "response", "query-id": "11", "response": null, "status": "success"} -{"kind": "response", "query-id": "12", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [3, 14], "end": [3, 14], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "13", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [4, 0], "end": [4, 0], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "14", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [3, 15], "end": [3, 15], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "15", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [3, 15], "end": [3, 15], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "16", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [3, 15], "end": [3, 15], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "12", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [3, 14], "end": [3, 14], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "13", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [4, 0], "end": [4, 0], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "14", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [3, 15], "end": [3, 15], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "15", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [3, 15], "end": [3, 15], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "16", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [3, 15], "end": [3, 15], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "17", "response": [], "status": "success"} -{"kind": "response", "query-id": "18", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type a: nat{a > 2} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 24], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "18", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type a: nat{a > 2} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 24], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "19", "response": [], "status": "success"} {"kind": "response", "query-id": "20", "response": [], "status": "success"} -{"kind": "response", "query-id": "21", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type a: nat{a > 1} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 24], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "21", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type a: nat{a > 1} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 24], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "22", "response": [], "status": "success"} {"kind": "response", "query-id": "23", "response": [], "status": "success"} {"kind": "response", "query-id": "24", "response": null, "status": "success"} {"kind": "response", "query-id": "25", "response": [], "status": "success"} -{"kind": "response", "query-id": "26", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type a: nat{a > 0} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 25], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "26", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type a: nat{a > 0} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 25], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "27", "response": [], "status": "success"} {"kind": "response", "query-id": "28", "response": [], "status": "success"} {"kind": "response", "query-id": "29", "response": [], "status": "success"} {"kind": "response", "query-id": "30", "response": [], "status": "success"} -{"kind": "response", "query-id": "31", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [5, 5], "end": [5, 5], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "32", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [5, 8], "end": [5, 8], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "31", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [5, 5], "end": [5, 5], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "32", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [5, 8], "end": [5, 8], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "33", "response": [], "status": "success"} {"kind": "response", "query-id": "34", "response": [], "status": "success"} -{"kind": "response", "query-id": "35", "response": [{"level": "error", "message": " - Identifier not found: [b]\n", "number": 72, "ranges": [{"beg": [5, 7], "end": [5, 8], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "36", "response": [{"level": "error", "message": " - Identifier not found: [b]\n", "number": 72, "ranges": [{"beg": [5, 7], "end": [5, 8], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "35", "response": [{"level": "error", "message": "- Identifier not found: [b]\n", "number": 72, "ranges": [{"beg": [5, 7], "end": [5, 8], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "36", "response": [{"level": "error", "message": "- Identifier not found: [b]\n", "number": 72, "ranges": [{"beg": [5, 7], "end": [5, 8], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "37", "response": [[3, "Prims", "nat"], [0, "", "nat"]], "status": "success"} {"kind": "response", "query-id": "38", "response": [], "status": "success"} -{"kind": "response", "query-id": "39", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [5, 15], "end": [5, 15], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "40", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [5, 19], "end": [5, 19], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "41", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [5, 26], "end": [5, 26], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "39", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [5, 15], "end": [5, 15], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "40", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [5, 19], "end": [5, 19], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "41", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [5, 26], "end": [5, 26], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "42", "response": [], "status": "success"} {"kind": "response", "query-id": "43", "response": [], "status": "success"} {"kind": "response", "query-id": "44", "response": [], "status": "success"} -{"kind": "response", "query-id": "45", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type b: nat{b > 1} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (5,13-5,18)\n", "number": 19, "ranges": [{"beg": [5, 22], "end": [5, 31], "fname": ""}, {"beg": [5, 13], "end": [5, 18], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "45", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type b: nat{b > 1} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (5,13-5,18)\n", "number": 19, "ranges": [{"beg": [5, 22], "end": [5, 31], "fname": ""}, {"beg": [5, 13], "end": [5, 18], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "46", "response": [], "status": "success"} {"kind": "response", "query-id": "47", "response": [], "status": "success"} {"kind": "response", "query-id": "48", "response": [], "status": "success"} @@ -53,7 +53,7 @@ {"kind": "response", "query-id": "52", "response": [], "status": "success"} {"kind": "response", "query-id": "53", "response": null, "status": "success"} {"kind": "response", "query-id": "54", "response": [], "status": "success"} -{"kind": "response", "query-id": "55", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type b: nat{b > 1} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (5,13-5,18)\n", "number": 19, "ranges": [{"beg": [5, 22], "end": [5, 31], "fname": ""}, {"beg": [5, 13], "end": [5, 18], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "55", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type b: nat{b > 1} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (5,13-5,18)\n", "number": 19, "ranges": [{"beg": [5, 22], "end": [5, 31], "fname": ""}, {"beg": [5, 13], "end": [5, 18], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "56", "response": null, "status": "success"} {"kind": "response", "query-id": "57", "response": [], "status": "success"} {"kind": "response", "query-id": "58", "response": [], "status": "success"} @@ -61,12 +61,12 @@ {"kind": "response", "query-id": "60", "response": null, "status": "success"} {"kind": "response", "query-id": "61", "response": null, "status": "success"} {"kind": "response", "query-id": "62", "response": [], "status": "success"} -{"kind": "response", "query-id": "63", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type a: nat{a > 0} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 25], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "63", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type a: nat{a > 0} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 25], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "64", "response": [], "status": "success"} -{"kind": "response", "query-id": "65", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type a: nat{a > 0} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 24], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "65", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type a: nat{a > 0} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 24], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "66", "response": [], "status": "success"} {"kind": "response", "query-id": "67", "response": [], "status": "success"} -{"kind": "response", "query-id": "68", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type b: nat{b > 1} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (5,13-5,18)\n", "number": 19, "ranges": [{"beg": [5, 22], "end": [5, 31], "fname": ""}, {"beg": [5, 13], "end": [5, 18], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "68", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type b: nat{b > 1} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (5,13-5,18)\n", "number": 19, "ranges": [{"beg": [5, 22], "end": [5, 31], "fname": ""}, {"beg": [5, 13], "end": [5, 18], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "69", "response": null, "status": "success"} {"kind": "response", "query-id": "70", "response": [], "status": "success"} {"kind": "response", "query-id": "71", "response": [], "status": "success"} diff --git a/tests/ide/emacs/fstarmode_gh73.out.expected b/tests/ide/emacs/fstarmode_gh73.out.expected index 8af8e967970..b8a03924c64 100644 --- a/tests/ide/emacs/fstarmode_gh73.out.expected +++ b/tests/ide/emacs/fstarmode_gh73.out.expected @@ -1,7 +1,7 @@ {"kind": "protocol-info", "rest": "[...]"} -{"kind": "response", "query-id": "1", "response": [{"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [135, 17], "end": [135, 24], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [136, 22], "end": [136, 29], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Adding an implicit 'assume new' qualifier on document\n", "number": 239, "ranges": [{"beg": [36, 5], "end": [36, 13], "fname": "FStar.Stubs.Pprint.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [623, 15], "end": [623, 22], "fname": "FStar.Tactics.V2.Derived.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [176, 11], "end": [176, 18], "fname": "FStar.Tactics.V2.Logic.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Pattern uses these theory symbols or terms that should not be in an SMT\n pattern:\n Prims.op_Subtraction\n", "number": 271, "ranges": [{"beg": [434, 8], "end": [434, 51], "fname": "FStar.UInt.fsti"}]}], "status": "success"} -{"kind": "response", "query-id": "2", "response": [{"level": "error", "message": " - Expected expression of type int got expression \"A\" of type string\n", "number": 189, "ranges": [{"beg": [4, 48], "end": [4, 51], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": " - Expected expression of type int got expression \"A\" of type string\n", "number": 189, "ranges": [{"beg": [4, 48], "end": [4, 51], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "1", "response": [{"level": "warning", "message": "- FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n- Use FStar.Reflection.V2.TermEq.term_eq\n- See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [135, 17], "end": [135, 24], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": "- FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n- Use FStar.Reflection.V2.TermEq.term_eq\n- See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [136, 22], "end": [136, 29], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": "- Adding an implicit 'assume new' qualifier on document\n", "number": 239, "ranges": [{"beg": [36, 5], "end": [36, 13], "fname": "FStar.Stubs.Pprint.fsti"}]}, {"level": "warning", "message": "- FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n- Use FStar.Reflection.V2.TermEq.term_eq\n- See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [623, 15], "end": [623, 22], "fname": "FStar.Tactics.V2.Derived.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": "- FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n- Use FStar.Reflection.V2.TermEq.term_eq\n- See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [176, 11], "end": [176, 18], "fname": "FStar.Tactics.V2.Logic.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": "- Pattern uses these theory symbols or terms that should not be in an SMT\n pattern:\n Prims.op_Subtraction\n", "number": 271, "ranges": [{"beg": [434, 8], "end": [434, 51], "fname": "FStar.UInt.fsti"}]}], "status": "success"} +{"kind": "response", "query-id": "2", "response": [{"level": "error", "message": "- Expected expression of type int got expression \"A\" of type string\n", "number": 189, "ranges": [{"beg": [4, 48], "end": [4, 51], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": "- Expected expression of type int got expression \"A\" of type string\n", "number": 189, "ranges": [{"beg": [4, 48], "end": [4, 51], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "4", "response": [], "status": "success"} {"contents": {"depth": 1, "goals": [{"goal": {"label": "", "type": "bool", "witness": "(*?u[...]*) _"}, "hyps": []}], "label": "at the time of failure", "location": {"beg": [109, 12], "end": [109, 16], "fname": "FStar.Tactics.V2.Derived.fst"}, "smt-goals": [], "urgency": 1}, "kind": "message", "level": "proof-state", "query-id": "5"} -{"kind": "response", "query-id": "5", "response": [{"level": "error", "message": " - Tactic failed\n - exact failed\n - 1 : int does not exactly solve the goal bool (witness = (*?u[...]*) _)\n - See also FStar.Tactics.V2.Derived.fst(109,12-109,16)\n", "number": 228, "ranges": [{"beg": [4, 14], "end": [4, 29], "fname": ""}, {"beg": [109, 12], "end": [109, 16], "fname": "FStar.Tactics.V2.Derived.fst"}]}], "status": "failure"} +{"kind": "response", "query-id": "5", "response": [{"level": "error", "message": "- Tactic failed\n- exact failed\n- 1 : int does not exactly solve the goal bool (witness = (*?u[...]*) _)\n- See also FStar.Tactics.V2.Derived.fst(109,12-109,16)\n", "number": 228, "ranges": [{"beg": [4, 14], "end": [4, 29], "fname": ""}, {"beg": [109, 12], "end": [109, 16], "fname": "FStar.Tactics.V2.Derived.fst"}]}], "status": "failure"} diff --git a/tests/ide/emacs/integration.push-pop.out.expected b/tests/ide/emacs/integration.push-pop.out.expected index 67ba0e83bb4..0cdb5d1f56d 100644 --- a/tests/ide/emacs/integration.push-pop.out.expected +++ b/tests/ide/emacs/integration.push-pop.out.expected @@ -76,40 +76,40 @@ {"kind": "response", "query-id": "75", "response": [], "status": "success"} {"kind": "response", "query-id": "79", "response": [], "status": "success"} {"kind": "response", "query-id": "80", "response": [], "status": "success"} -{"kind": "response", "query-id": "91", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [12, 0], "end": [12, 0], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "91", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [12, 0], "end": [12, 0], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "98", "response": [], "status": "success"} -{"kind": "response", "query-id": "101", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type nat got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} +{"kind": "response", "query-id": "101", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type nat got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} {"kind": "response", "query-id": "107", "response": [], "status": "success"} {"kind": "response", "query-id": "108", "response": [], "status": "success"} {"kind": "response", "query-id": "112", "response": null, "status": "success"} {"kind": "response", "query-id": "114", "response": [], "status": "success"} -{"kind": "response", "query-id": "116", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type nat got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} +{"kind": "response", "query-id": "116", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type nat got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} {"kind": "response", "query-id": "118", "response": [], "status": "success"} {"kind": "response", "query-id": "119", "response": [], "status": "success"} {"kind": "response", "query-id": "122", "response": null, "status": "success"} {"kind": "response", "query-id": "124", "response": [], "status": "success"} -{"kind": "response", "query-id": "126", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type nat got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} +{"kind": "response", "query-id": "126", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type nat got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} {"kind": "response", "query-id": "128", "response": [], "status": "success"} {"kind": "response", "query-id": "130", "response": [], "status": "success"} {"kind": "response", "query-id": "133", "response": [], "status": "success"} -{"kind": "response", "query-id": "137", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [13, 4], "end": [13, 4], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "159", "response": [{"level": "error", "message": " - Expected expression of type Type0 got expression xx of type nat\n", "number": 189, "ranges": [{"beg": [13, 15], "end": [13, 20], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "137", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [13, 4], "end": [13, 4], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "159", "response": [{"level": "error", "message": "- Expected expression of type Type0 got expression xx of type nat\n", "number": 189, "ranges": [{"beg": [13, 15], "end": [13, 20], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "163", "response": [], "status": "success"} {"kind": "response", "query-id": "164", "response": [], "status": "success"} -{"kind": "response", "query-id": "165", "response": [{"level": "error", "message": " - Assertion failed\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (13,15-13,23)\n", "number": 19, "ranges": [{"beg": [13, 8], "end": [13, 14], "fname": ""}, {"beg": [13, 15], "end": [13, 23], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "165", "response": [{"level": "error", "message": "- Assertion failed\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (13,15-13,23)\n", "number": 19, "ranges": [{"beg": [13, 8], "end": [13, 14], "fname": ""}, {"beg": [13, 15], "end": [13, 23], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "170", "response": [], "status": "success"} -{"kind": "response", "query-id": "175", "response": [{"level": "error", "message": " - Unexpected numeric literal. Restart F* to load FStar.UInt8.\n", "number": 201, "ranges": [{"beg": [13, 22], "end": [13, 24], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "175", "response": [{"level": "error", "message": "- Unexpected numeric literal. Restart F* to load FStar.UInt8.\n", "number": 201, "ranges": [{"beg": [13, 22], "end": [13, 24], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "179", "response": [], "status": "success"} -{"kind": "response", "query-id": "180", "response": [{"level": "error", "message": " - Assertion failed\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (13,15-13,24)\n", "number": 19, "ranges": [{"beg": [13, 8], "end": [13, 14], "fname": ""}, {"beg": [13, 15], "end": [13, 24], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "180", "response": [{"level": "error", "message": "- Assertion failed\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (13,15-13,24)\n", "number": 19, "ranges": [{"beg": [13, 8], "end": [13, 14], "fname": ""}, {"beg": [13, 15], "end": [13, 24], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "185", "response": [], "status": "success"} {"kind": "response", "query-id": "186", "response": [], "status": "success"} {"kind": "response", "query-id": "191", "response": null, "status": "success"} {"kind": "response", "query-id": "192", "response": null, "status": "success"} {"kind": "response", "query-id": "194", "response": [], "status": "success"} -{"kind": "response", "query-id": "198", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type nat got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} +{"kind": "response", "query-id": "198", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type nat got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} {"kind": "response", "query-id": "200", "response": [], "status": "success"} {"kind": "response", "query-id": "204", "response": [], "status": "success"} -{"kind": "response", "query-id": "205", "response": [{"level": "error", "message": " - Assertion failed\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (13,15-13,23)\n", "number": 19, "ranges": [{"beg": [13, 8], "end": [13, 14], "fname": ""}, {"beg": [13, 15], "end": [13, 23], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "205", "response": [{"level": "error", "message": "- Assertion failed\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (13,15-13,23)\n", "number": 19, "ranges": [{"beg": [13, 8], "end": [13, 14], "fname": ""}, {"beg": [13, 15], "end": [13, 23], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "211", "response": [], "status": "success"} {"kind": "response", "query-id": "213", "response": [], "status": "success"} {"kind": "response", "query-id": "214", "response": [], "status": "success"} diff --git a/tests/ide/emacs/number.interface-violation-and-fix.out.expected b/tests/ide/emacs/number.interface-violation-and-fix.out.expected index 781916a9e28..e2823b698d2 100644 --- a/tests/ide/emacs/number.interface-violation-and-fix.out.expected +++ b/tests/ide/emacs/number.interface-violation-and-fix.out.expected @@ -1,7 +1,7 @@ {"kind": "protocol-info", "rest": "[...]"} {"kind": "response", "query-id": "1", "response": null, "status": "success"} {"kind": "response", "query-id": "2", "response": [], "status": "success"} -{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type a: int{a > 0} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also number.fsti(18,14-18,19)\n", "number": 19, "ranges": [{"beg": [3, 8], "end": [3, 10], "fname": ""}, {"beg": [18, 14], "end": [18, 19], "fname": "number.fsti"}]}], "status": "failure"} +{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type a: int{a > 0} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also number.fsti(18,14-18,19)\n", "number": 19, "ranges": [{"beg": [3, 8], "end": [3, 10], "fname": ""}, {"beg": [18, 14], "end": [18, 19], "fname": "number.fsti"}]}], "status": "failure"} {"kind": "response", "query-id": "4", "response": null, "status": "success"} {"kind": "response", "query-id": "5", "response": null, "status": "success"} {"kind": "response", "query-id": "6", "response": [], "status": "success"} diff --git a/tests/ide/emacs/number.interface-violation.out.expected b/tests/ide/emacs/number.interface-violation.out.expected index 80448802552..59c46faba85 100644 --- a/tests/ide/emacs/number.interface-violation.out.expected +++ b/tests/ide/emacs/number.interface-violation.out.expected @@ -1,4 +1,4 @@ {"kind": "protocol-info", "rest": "[...]"} {"kind": "response", "query-id": "1", "response": null, "status": "success"} {"kind": "response", "query-id": "2", "response": [], "status": "success"} -{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": " - Subtyping check failed\n - Expected type a: int{a > 0} got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also number.fsti(18,14-18,19)\n", "number": 19, "ranges": [{"beg": [3, 8], "end": [3, 10], "fname": ""}, {"beg": [18, 14], "end": [18, 19], "fname": "number.fsti"}]}], "status": "failure"} +{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type a: int{a > 0} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also number.fsti(18,14-18,19)\n", "number": 19, "ranges": [{"beg": [3, 8], "end": [3, 10], "fname": ""}, {"beg": [18, 14], "end": [18, 19], "fname": "number.fsti"}]}], "status": "failure"} diff --git a/tests/ide/emacs/tutorial.push.out.expected b/tests/ide/emacs/tutorial.push.out.expected index 4915da84619..600019d8b92 100644 --- a/tests/ide/emacs/tutorial.push.out.expected +++ b/tests/ide/emacs/tutorial.push.out.expected @@ -1,5 +1,5 @@ {"kind": "protocol-info", "rest": "[...]"} -{"kind": "response", "query-id": "1", "response": [{"level": "warning", "message": " - Pattern uses these theory symbols or terms that should not be in an SMT\n pattern:\n Prims.op_Subtraction\n", "number": 271, "ranges": [{"beg": [434, 8], "end": [434, 51], "fname": "FStar.UInt.fsti"}]}], "status": "success"} +{"kind": "response", "query-id": "1", "response": [{"level": "warning", "message": "- Pattern uses these theory symbols or terms that should not be in an SMT\n pattern:\n Prims.op_Subtraction\n", "number": 271, "ranges": [{"beg": [434, 8], "end": [434, 51], "fname": "FStar.UInt.fsti"}]}], "status": "success"} {"kind": "response", "query-id": "2", "response": [], "status": "success"} {"kind": "response", "query-id": "3", "response": [], "status": "success"} {"kind": "response", "query-id": "4", "response": [], "status": "success"} @@ -9,7 +9,7 @@ {"kind": "response", "query-id": "8", "response": [], "status": "success"} {"kind": "response", "query-id": "9", "response": [], "status": "success"} {"kind": "response", "query-id": "10", "response": [], "status": "success"} -{"kind": "response", "query-id": "11", "response": [{"level": "warning", "message": " - Top-level let-bindings must be total; this term may have effects\n", "number": 272, "ranges": [{"beg": [60, 0], "end": [60, 48], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "11", "response": [{"level": "warning", "message": "- Top-level let-bindings must be total; this term may have effects\n", "number": 272, "ranges": [{"beg": [60, 0], "end": [60, 48], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "a1", "response": null, "status": "success"} {"kind": "response", "query-id": "a2", "response": null, "status": "success"} {"kind": "response", "query-id": "a3", "response": null, "status": "success"} From 2a9e15f55be740f73647a18baa150da27e3fba1a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Tue, 14 May 2024 15:40:47 -0700 Subject: [PATCH 189/239] snap --- ocaml/fstar-lib/generated/FStar_Errors.ml | 17 ++-- ocaml/fstar-lib/generated/FStar_Errors_Msg.ml | 37 ++++--- .../generated/FStar_TypeChecker_Err.ml | 99 ++++++++++++------- .../generated/FStar_TypeChecker_TcTerm.ml | 4 +- 4 files changed, 94 insertions(+), 63 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Errors.ml b/ocaml/fstar-lib/generated/FStar_Errors.ml index b14d51365f4..caf6b6587e7 100644 --- a/ocaml/fstar-lib/generated/FStar_Errors.ml +++ b/ocaml/fstar-lib/generated/FStar_Errors.ml @@ -389,19 +389,18 @@ let (format_issue' : Prims.bool -> issue -> Prims.string) = FStar_Pprint.op_Hat_Hat FStar_Pprint.hardline uu___2 in FStar_Pprint.op_Hat_Hat l uu___1) uu___ t | uu___ -> FStar_Pprint.empty in + let subdoc = FStar_Errors_Msg.subdoc' print_hdr in let mainmsg = let uu___ = FStar_Compiler_List.map - (fun d -> - let uu___1 = FStar_Pprint.group d in - FStar_Errors_Msg.subdoc uu___1) issue1.issue_msg in + (fun d -> let uu___1 = FStar_Pprint.group d in subdoc uu___1) + issue1.issue_msg in FStar_Pprint.concat uu___ in let doc = let uu___ = let uu___1 = - let uu___2 = FStar_Errors_Msg.subdoc seealso in - let uu___3 = FStar_Errors_Msg.subdoc ctx in - FStar_Pprint.op_Hat_Hat uu___2 uu___3 in + let uu___2 = subdoc seealso in + let uu___3 = subdoc ctx in FStar_Pprint.op_Hat_Hat uu___2 uu___3 in FStar_Pprint.op_Hat_Hat mainmsg uu___1 in FStar_Pprint.op_Hat_Hat hdr uu___ in FStar_Errors_Msg.renderdoc doc @@ -740,7 +739,7 @@ let (set_option_warning_callback_range : FStar_Compiler_Range_Type.range FStar_Pervasives_Native.option -> unit) = fun ropt -> FStar_Options.set_option_warning_callback (warn_unsafe_options ropt) -let (uu___385 : +let (uu___386 : (((Prims.string -> FStar_Errors_Codes.error_setting Prims.list) -> unit) * (unit -> FStar_Errors_Codes.error_setting Prims.list))) = @@ -786,10 +785,10 @@ let (uu___385 : (set_callbacks, get_error_flags) let (t_set_parse_warn_error : (Prims.string -> FStar_Errors_Codes.error_setting Prims.list) -> unit) = - match uu___385 with + match uu___386 with | (t_set_parse_warn_error1, error_flags) -> t_set_parse_warn_error1 let (error_flags : unit -> FStar_Errors_Codes.error_setting Prims.list) = - match uu___385 with + match uu___386 with | (t_set_parse_warn_error1, error_flags1) -> error_flags1 let (set_parse_warn_error : (Prims.string -> FStar_Errors_Codes.error_setting Prims.list) -> unit) = diff --git a/ocaml/fstar-lib/generated/FStar_Errors_Msg.ml b/ocaml/fstar-lib/generated/FStar_Errors_Msg.ml index f1459a8ec5f..82b51469080 100644 --- a/ocaml/fstar-lib/generated/FStar_Errors_Msg.ml +++ b/ocaml/fstar-lib/generated/FStar_Errors_Msg.ml @@ -45,22 +45,29 @@ let (backtrace_doc : unit -> FStar_Pprint.document) = let uu___2 = FStar_Pprint.arbitrary_string (FStar_Compiler_Util.trim_string s) in FStar_Pprint.op_Hat_Slash_Hat uu___1 uu___2 +let (subdoc' : Prims.bool -> FStar_Pprint.document -> FStar_Pprint.document) + = + fun indent -> + fun d -> + if d = FStar_Pprint.empty + then FStar_Pprint.empty + else + (let uu___1 = + if indent + then FStar_Pprint.blank (Prims.of_int (2)) + else FStar_Pprint.empty in + let uu___2 = + let uu___3 = FStar_Pprint.doc_of_string "-" in + let uu___4 = + let uu___5 = FStar_Pprint.blank Prims.int_one in + let uu___6 = + let uu___7 = FStar_Pprint.align d in + FStar_Pprint.op_Hat_Hat uu___7 FStar_Pprint.hardline in + FStar_Pprint.op_Hat_Hat uu___5 uu___6 in + FStar_Pprint.op_Hat_Hat uu___3 uu___4 in + FStar_Pprint.op_Hat_Hat uu___1 uu___2) let (subdoc : FStar_Pprint.document -> FStar_Pprint.document) = - fun d -> - if d = FStar_Pprint.empty - then FStar_Pprint.empty - else - (let uu___1 = FStar_Pprint.blank (Prims.of_int (2)) in - let uu___2 = - let uu___3 = FStar_Pprint.doc_of_string "-" in - let uu___4 = - let uu___5 = FStar_Pprint.blank Prims.int_one in - let uu___6 = - let uu___7 = FStar_Pprint.align d in - FStar_Pprint.op_Hat_Hat uu___7 FStar_Pprint.hardline in - FStar_Pprint.op_Hat_Hat uu___5 uu___6 in - FStar_Pprint.op_Hat_Hat uu___3 uu___4 in - FStar_Pprint.op_Hat_Hat uu___1 uu___2) + fun d -> subdoc' true d let (rendermsg : error_message -> Prims.string) = fun ds -> let uu___ = diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml index 8ad26c31e13..dc147a0f93e 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml @@ -564,50 +564,75 @@ let (unexpected_non_trivial_precondition_on_term : FStar_Compiler_Util.format1 "Term has an unexpected non-trivial pre-condition: %s" uu___1 in (FStar_Errors_Codes.Fatal_UnExpectedPreCondition, uu___) +let (__expected_eff_expression : + Prims.string -> + FStar_Syntax_Syntax.term -> + FStar_Syntax_Syntax.comp -> + Prims.string -> + (FStar_Errors_Codes.raw_error * FStar_Pprint.document Prims.list)) + = + fun effname -> + fun e -> + fun c -> + fun reason -> + let uu___ = + let uu___1 = + FStar_Errors_Msg.text + (Prims.strcat "Expected a " + (Prims.strcat effname " expression.")) in + let uu___2 = + let uu___3 = + if reason = "" + then FStar_Pprint.empty + else + (let uu___5 = FStar_Pprint.break_ Prims.int_one in + let uu___6 = + let uu___7 = FStar_Pprint.doc_of_string "Because:" in + let uu___8 = + FStar_Pprint.words (Prims.strcat reason ".") in + uu___7 :: uu___8 in + FStar_Pprint.flow uu___5 uu___6) in + let uu___4 = + let uu___5 = + let uu___6 = + let uu___7 = FStar_Errors_Msg.text "Got an expression" in + let uu___8 = + FStar_Class_PP.pp FStar_Syntax_Print.pretty_term e in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one + uu___7 uu___8 in + let uu___7 = + let uu___8 = + let uu___9 = FStar_Errors_Msg.text "with effect" in + let uu___10 = + let uu___11 = + let uu___12 = + let uu___13 = name_and_result c in + FStar_Pervasives_Native.fst uu___13 in + FStar_Pprint.doc_of_string uu___12 in + FStar_Pprint.squotes uu___11 in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one + uu___9 uu___10 in + FStar_Pprint.op_Hat_Hat uu___8 FStar_Pprint.dot in + FStar_Pprint.op_Hat_Slash_Hat uu___6 uu___7 in + [uu___5] in + uu___3 :: uu___4 in + uu___1 :: uu___2 in + (FStar_Errors_Codes.Fatal_ExpectedGhostExpression, uu___) let (expected_pure_expression : FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> - Prims.string -> (FStar_Errors_Codes.raw_error * Prims.string)) + FStar_Syntax_Syntax.comp -> + Prims.string -> + (FStar_Errors_Codes.raw_error * FStar_Pprint.document Prims.list)) = - fun e -> - fun c -> - fun reason -> - let msg = "Expected a pure expression" in - let msg1 = - if reason = "" - then msg - else FStar_Compiler_Util.format1 (Prims.strcat msg " (%s)") reason in - let uu___ = - let uu___1 = FStar_Syntax_Print.term_to_string e in - let uu___2 = - let uu___3 = name_and_result c in - FStar_Pervasives_Native.fst uu___3 in - FStar_Compiler_Util.format2 - (Prims.strcat msg1 - "; got an expression \"%s\" with effect \"%s\"") uu___1 uu___2 in - (FStar_Errors_Codes.Fatal_ExpectedPureExpression, uu___) + fun e -> fun c -> fun reason -> __expected_eff_expression "pure" e c reason let (expected_ghost_expression : FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> - Prims.string -> (FStar_Errors_Codes.raw_error * Prims.string)) + FStar_Syntax_Syntax.comp -> + Prims.string -> + (FStar_Errors_Codes.raw_error * FStar_Pprint.document Prims.list)) = fun e -> - fun c -> - fun reason -> - let msg = "Expected a ghost expression" in - let msg1 = - if reason = "" - then msg - else FStar_Compiler_Util.format1 (Prims.strcat msg " (%s)") reason in - let uu___ = - let uu___1 = FStar_Syntax_Print.term_to_string e in - let uu___2 = - let uu___3 = name_and_result c in - FStar_Pervasives_Native.fst uu___3 in - FStar_Compiler_Util.format2 - (Prims.strcat msg1 - "; got an expression \"%s\" with effect \"%s\"") uu___1 uu___2 in - (FStar_Errors_Codes.Fatal_ExpectedGhostExpression, uu___) + fun c -> fun reason -> __expected_eff_expression "ghost" e c reason let (expected_effect_1_got_effect_2 : FStar_Ident.lident -> FStar_Ident.lident -> (FStar_Errors_Codes.raw_error * Prims.string)) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml index fbaf359917a..efbda6e80c7 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml @@ -12289,13 +12289,13 @@ and (tc_tot_or_gtot_term_maybe_solve_deferred : let uu___7 = FStar_TypeChecker_Err.expected_ghost_expression e1 c2 msg in - FStar_Errors.raise_error uu___7 + FStar_Errors.raise_error_doc uu___7 e1.FStar_Syntax_Syntax.pos else (let uu___8 = FStar_TypeChecker_Err.expected_pure_expression e1 c2 msg in - FStar_Errors.raise_error uu___8 + FStar_Errors.raise_error_doc uu___8 e1.FStar_Syntax_Syntax.pos)))) and (tc_tot_or_gtot_term' : FStar_TypeChecker_Env.env -> From 3132f1251771e3156d2c71d401655b32530b3ccb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 29 Apr 2024 14:41:46 -0700 Subject: [PATCH 190/239] Tactics: if dump_on_failure is true, do not add Tactic failed prefix --- src/tactics/FStar.Tactics.Interpreter.fst | 2 +- src/tactics/FStar.Tactics.V2.Basic.fst | 11 ++++++++--- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/src/tactics/FStar.Tactics.Interpreter.fst b/src/tactics/FStar.Tactics.Interpreter.fst index a5a0430e086..6db239b1f85 100644 --- a/src/tactics/FStar.Tactics.Interpreter.fst +++ b/src/tactics/FStar.Tactics.Interpreter.fst @@ -388,7 +388,7 @@ let run_unembedded_tactic_on_ps in let open FStar.Pprint in Err.raise_error_doc (Err.Fatal_UserTacticFailure, ( - [doc_of_string "Tactic failed"] + (if ps.dump_on_failure then [doc_of_string "Tactic failed"] else []) @ texn_to_doc e) ) rng diff --git a/src/tactics/FStar.Tactics.V2.Basic.fst b/src/tactics/FStar.Tactics.V2.Basic.fst index c30dbb101e4..e31b541229b 100644 --- a/src/tactics/FStar.Tactics.V2.Basic.fst +++ b/src/tactics/FStar.Tactics.V2.Basic.fst @@ -2765,9 +2765,14 @@ let resolve_name (e:env) (n:list string) = let log_issues (is : list Errors.issue) : tac unit = let open FStar.Errors in let! ps = get in - (* Prepend an error component *) - let is = is |> - List.map (fun i -> { i with issue_msg = (Errors.text "Tactic logged issue:")::i.issue_msg }) + (* Prepend an error component, unless the tactic handles its own errors. *) + let is = + if ps.dump_on_failure + then + is |> + List.map (fun i -> { i with issue_msg = (Errors.text "Tactic logged issue:")::i.issue_msg }) + else + is in add_issues is; return () From acc353e6f5d071cc3c89ace5537ae1bbf27f695f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 29 Apr 2024 15:31:02 -0700 Subject: [PATCH 191/239] snap --- .../generated/FStar_Tactics_Interpreter.ml | 9 +++-- .../generated/FStar_Tactics_V2_Basic.ml | 33 +++++++++++-------- 2 files changed, 25 insertions(+), 17 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Interpreter.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Interpreter.ml index b282ec92678..0f63e417417 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Interpreter.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Interpreter.ml @@ -1102,9 +1102,12 @@ let run_unembedded_tactic_on_ps : let uu___2 = let uu___3 = let uu___4 = - let uu___5 = - FStar_Pprint.doc_of_string "Tactic failed" in - [uu___5] in + if ps3.FStar_Tactics_Types.dump_on_failure + then + let uu___5 = + FStar_Pprint.doc_of_string "Tactic failed" in + [uu___5] + else [] in let uu___5 = texn_to_doc e in FStar_Compiler_List.op_At uu___4 uu___5 in (FStar_Errors_Codes.Fatal_UserTacticFailure, uu___3) in diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml index 5926d58e105..5c755c0378d 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml @@ -12334,20 +12334,25 @@ let (log_issues : (fun ps -> let ps = Obj.magic ps in let is1 = - FStar_Compiler_List.map - (fun i -> - let uu___ = - let uu___1 = - FStar_Errors_Msg.text "Tactic logged issue:" in - uu___1 :: (i.FStar_Errors.issue_msg) in - { - FStar_Errors.issue_msg = uu___; - FStar_Errors.issue_level = (i.FStar_Errors.issue_level); - FStar_Errors.issue_range = (i.FStar_Errors.issue_range); - FStar_Errors.issue_number = - (i.FStar_Errors.issue_number); - FStar_Errors.issue_ctx = (i.FStar_Errors.issue_ctx) - }) is in + if ps.FStar_Tactics_Types.dump_on_failure + then + FStar_Compiler_List.map + (fun i -> + let uu___ = + let uu___1 = + FStar_Errors_Msg.text "Tactic logged issue:" in + uu___1 :: (i.FStar_Errors.issue_msg) in + { + FStar_Errors.issue_msg = uu___; + FStar_Errors.issue_level = + (i.FStar_Errors.issue_level); + FStar_Errors.issue_range = + (i.FStar_Errors.issue_range); + FStar_Errors.issue_number = + (i.FStar_Errors.issue_number); + FStar_Errors.issue_ctx = (i.FStar_Errors.issue_ctx) + }) is + else is in FStar_Errors.add_issues is1; Obj.magic (FStar_Class_Monad.return FStar_Tactics_Monad.monad_tac () From 1bfd750e37e62bf86b82b21f8243a705a30b7058 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 29 Apr 2024 15:31:28 -0700 Subject: [PATCH 192/239] Update expected output --- tests/error-messages/Bug1918.fst.expected | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/error-messages/Bug1918.fst.expected b/tests/error-messages/Bug1918.fst.expected index 59d8d956fab..62bc6a458eb 100644 --- a/tests/error-messages/Bug1918.fst.expected +++ b/tests/error-messages/Bug1918.fst.expected @@ -1,6 +1,5 @@ >> Got issues: [ * Error 228 at Bug1918.fst(11,13-11,14): - - Tactic failed - Typeclass resolution failed - Could not solve constraint Bug1918.mon - See also FStar.Tactics.Typeclasses.fst(293,6-297,7) From 1fd76796459032a400ffe68a09e2bc28086b188b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 15 May 2024 10:46:36 -0700 Subject: [PATCH 193/239] Print: more pp instances --- src/syntax/FStar.Syntax.Print.fst | 9 +++++++++ src/syntax/FStar.Syntax.Print.fsti | 2 ++ 2 files changed, 11 insertions(+) diff --git a/src/syntax/FStar.Syntax.Print.fst b/src/syntax/FStar.Syntax.Print.fst index c205bf7a3f2..ae656ab37bb 100644 --- a/src/syntax/FStar.Syntax.Print.fst +++ b/src/syntax/FStar.Syntax.Print.fst @@ -1020,3 +1020,12 @@ instance pretty_comp = { pp = comp_to_doc; } instance pretty_ctxu = { pp = (fun x -> Pprint.doc_of_string (show x)); } instance pretty_uvar = { pp = (fun x -> Pprint.doc_of_string (show x)); } instance pretty_binder = { pp = (fun x -> Pprint.doc_of_string (show x)); } +instance pretty_bv = { pp = (fun x -> Pprint.doc_of_string (show x)); } + +open FStar.Pprint + +instance pretty_binding : pretty binding = { + pp = (function Binding_var bv -> pp bv + | Binding_lid (l, (us, t)) -> pp l ^^ colon ^^ pp t + | Binding_univ u -> pp u); +} diff --git a/src/syntax/FStar.Syntax.Print.fsti b/src/syntax/FStar.Syntax.Print.fsti index 0a1d5f0875c..5a14bb1506a 100644 --- a/src/syntax/FStar.Syntax.Print.fsti +++ b/src/syntax/FStar.Syntax.Print.fsti @@ -114,3 +114,5 @@ instance val pretty_sigelt : pretty sigelt instance val pretty_uvar : pretty uvar instance val pretty_ctxu : pretty ctx_uvar instance val pretty_binder : pretty binder +instance val pretty_bv : pretty bv +instance val pretty_binding : pretty binding From ab68449668c3e58b002d31c5aaf739ff70590556 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 16 May 2024 11:59:15 -0700 Subject: [PATCH 194/239] snap --- .../fstar-lib/generated/FStar_Syntax_Print.ml | 23 +++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml index b4262aa55fe..3e389547659 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml @@ -2019,4 +2019,27 @@ let (pretty_binder : FStar_Syntax_Syntax.binder FStar_Class_PP.pretty) = (fun x -> let uu___ = FStar_Class_Show.show showable_binder x in FStar_Pprint.doc_of_string uu___) + } +let (pretty_bv : FStar_Syntax_Syntax.bv FStar_Class_PP.pretty) = + { + FStar_Class_PP.pp = + (fun x -> + let uu___ = FStar_Class_Show.show showable_bv x in + FStar_Pprint.doc_of_string uu___) + } +let (pretty_binding : FStar_Syntax_Syntax.binding FStar_Class_PP.pretty) = + { + FStar_Class_PP.pp = + (fun uu___ -> + match uu___ with + | FStar_Syntax_Syntax.Binding_var bv -> + FStar_Class_PP.pp pretty_bv bv + | FStar_Syntax_Syntax.Binding_lid (l, (us, t)) -> + let uu___1 = FStar_Class_PP.pp FStar_Ident.pretty_lident l in + let uu___2 = + let uu___3 = FStar_Class_PP.pp pretty_term t in + FStar_Pprint.op_Hat_Hat FStar_Pprint.colon uu___3 in + FStar_Pprint.op_Hat_Hat uu___1 uu___2 + | FStar_Syntax_Syntax.Binding_univ u -> + FStar_Class_PP.pp FStar_Ident.pretty_ident u) } \ No newline at end of file From 3dadef684f2d7b15269b4ec3a17b54a03a19c2ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 16 May 2024 11:14:31 -0700 Subject: [PATCH 195/239] Colorize warnings as yellow, diagnostics as cyan This makes the coloring consistent with the VS Code extension, and using yellow for warnings is usual anyway. --- ocaml/fstar-lib/FStar_Compiler_Util.ml | 2 +- src/basic/FStar.Errors.fst | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/ocaml/fstar-lib/FStar_Compiler_Util.ml b/ocaml/fstar-lib/FStar_Compiler_Util.ml index a34adb61afe..5b496565d88 100644 --- a/ocaml/fstar-lib/FStar_Compiler_Util.ml +++ b/ocaml/fstar-lib/FStar_Compiler_Util.ml @@ -545,7 +545,7 @@ type printer = { let default_printer = { printer_prinfo = (fun s -> pr "%s" s; flush stdout); - printer_prwarning = (fun s -> fpr stderr "%s" (colorize_cyan s); flush stdout; flush stderr); + printer_prwarning = (fun s -> fpr stderr "%s" (colorize_yellow s); flush stdout; flush stderr); printer_prerror = (fun s -> fpr stderr "%s" (colorize_red s); flush stdout; flush stderr); printer_prgeneric = fun label get_string get_json -> pr "%s: %s" label (get_string ())} diff --git a/src/basic/FStar.Errors.fst b/src/basic/FStar.Errors.fst index c5757bd7162..317cf8a2e1c 100644 --- a/src/basic/FStar.Errors.fst +++ b/src/basic/FStar.Errors.fst @@ -203,7 +203,7 @@ let format_issue issue : string = format_issue' true issue let print_issue issue = let printer = match issue.issue_level with - | EInfo -> (fun s -> BU.print_string (colorize_magenta s)) + | EInfo -> (fun s -> BU.print_string (colorize_cyan s)) | EWarning -> BU.print_warning | EError -> BU.print_error | ENotImplemented -> BU.print_error in From 17b07fe169a479a0b29085d0df9cdd4fb7887e9a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 16 May 2024 11:15:23 -0700 Subject: [PATCH 196/239] snap --- ocaml/fstar-lib/generated/FStar_Errors.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/fstar-lib/generated/FStar_Errors.ml b/ocaml/fstar-lib/generated/FStar_Errors.ml index caf6b6587e7..cbe4cb4e8c4 100644 --- a/ocaml/fstar-lib/generated/FStar_Errors.ml +++ b/ocaml/fstar-lib/generated/FStar_Errors.ml @@ -412,7 +412,7 @@ let (print_issue : issue -> unit) = match issue1.issue_level with | EInfo -> (fun s -> - let uu___ = FStar_Compiler_Util.colorize_magenta s in + let uu___ = FStar_Compiler_Util.colorize_cyan s in FStar_Compiler_Util.print_string uu___) | EWarning -> FStar_Compiler_Util.print_warning | EError -> FStar_Compiler_Util.print_error From d41341321c46042acf5c4b2678ba25fccd386c09 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 16 May 2024 17:46:18 -0700 Subject: [PATCH 197/239] Parser.AST: fix some operator arities --- src/parser/FStar.Parser.AST.fst | 8 ++++---- src/parser/FStar.Parser.AST.fsti | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/parser/FStar.Parser.AST.fst b/src/parser/FStar.Parser.AST.fst index 251f28b53a6..93b9987d5d0 100644 --- a/src/parser/FStar.Parser.AST.fst +++ b/src/parser/FStar.Parser.AST.fst @@ -328,15 +328,15 @@ let string_to_op s = match s with | "Amp" -> Some ("&", None) | "At" -> Some ("@", None) - | "Plus" -> Some ("+", None) + | "Plus" -> Some ("+", Some 2) | "Minus" -> Some ("-", None) | "Subtraction" -> Some ("-", Some 2) | "Tilde" -> Some ("~", None) - | "Slash" -> Some ("/", None) + | "Slash" -> Some ("/", Some 2) | "Backslash" -> Some ("\\", None) - | "Less" -> Some ("<", None) + | "Less" -> Some ("<", Some 2) | "Equals" -> Some ("=", None) - | "Greater" -> Some (">", None) + | "Greater" -> Some (">", Some 2) | "Underscore" -> Some ("_", None) | "Bar" -> Some ("|", None) | "Bang" -> Some ("!", None) diff --git a/src/parser/FStar.Parser.AST.fsti b/src/parser/FStar.Parser.AST.fsti index 101885e3cb5..55023b6d754 100644 --- a/src/parser/FStar.Parser.AST.fsti +++ b/src/parser/FStar.Parser.AST.fsti @@ -303,7 +303,7 @@ val strip_prefix : string -> string -> option string val compile_op : int -> string -> range -> string val compile_op' : string -> range -> string -val string_to_op : string -> option (string & option int) +val string_to_op : string -> option (string & option int) // returns operator symbol and optional arity val string_of_fsdoc : string & list (string & string) -> string val string_of_let_qualifier : let_qualifier -> string From ed2088fdce53271f3da5d4c6870c5df3071a1306 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 16 May 2024 17:48:51 -0700 Subject: [PATCH 198/239] Add test for #3292 --- tests/error-messages/Bug3292.fst | 19 +++ tests/error-messages/Bug3292.fst.expected | 155 ++++++++++++++++++++++ tests/error-messages/Makefile | 1 + 3 files changed, 175 insertions(+) create mode 100644 tests/error-messages/Bug3292.fst create mode 100644 tests/error-messages/Bug3292.fst.expected diff --git a/tests/error-messages/Bug3292.fst b/tests/error-messages/Bug3292.fst new file mode 100644 index 00000000000..842482e4426 --- /dev/null +++ b/tests/error-messages/Bug3292.fst @@ -0,0 +1,19 @@ +module Bug3292 + +#set-options "--print_implicits" + +let op_Plus #a (x y : a) = (x,y) +let op_Minus #a (x y : a) = (x,y) +let op_Slash #a (x y : a) = (x,y) +let op_Greater #a (x y : a) = (x,y) +let op_Less #a (x y : a) = (x,y) +let op_GreaterEquals #a (x y : a) = (x,y) +let op_LessEquals #a (x y : a) = (x,y) + +let _ = 1 + 1 +let _ = 1 - 1 +let _ = 1 / 1 +let _ = 1 > 1 +let _ = 1 < 1 +let _ = 1 >= 1 +let _ = 1 <= 1 diff --git a/tests/error-messages/Bug3292.fst.expected b/tests/error-messages/Bug3292.fst.expected new file mode 100644 index 00000000000..a678197fff9 --- /dev/null +++ b/tests/error-messages/Bug3292.fst.expected @@ -0,0 +1,155 @@ +Module after desugaring: +module Bug3292 +Declarations: [ +#set-options "--print_implicits" +let op_Plus #a x y = x, y +let op_Minus #a x y = x, y +let op_Slash #a x y = x, y +let op_Greater #a x y = x, y +let op_Less #a x y = x, y +let op_GreaterEquals #a x y = x, y +let op_LessEquals #a x y = x, y +private +let _ = 1 + 1 +private +let _ = 1 - 1 +private +let _ = 1 / 1 +private +let _ = 1 > 1 +private +let _ = 1 < 1 +private +let _ = 1 >= 1 +private +let _ = 1 <= 1 +] +Exports: [ +#set-options "--print_implicits" +let op_Plus #a x y = x, y +let op_Minus #a x y = x, y +let op_Slash #a x y = x, y +let op_Greater #a x y = x, y +let op_Less #a x y = x, y +let op_GreaterEquals #a x y = x, y +let op_LessEquals #a x y = x, y +private +let _ = 1 + 1 +private +let _ = 1 - 1 +private +let _ = 1 / 1 +private +let _ = 1 > 1 +private +let _ = 1 < 1 +private +let _ = 1 >= 1 +private +let _ = 1 <= 1 +] + +Module before type checking: +module Bug3292 +Declarations: [ +#set-options "--print_implicits" +let op_Plus x y = x, y +let op_Minus x y = x, y +let op_Slash x y = x, y +let op_Greater x y = x, y +let op_Less x y = x, y +let op_GreaterEquals x y = x, y +let op_LessEquals x y = x, y +private +let _ = 1 + 1 +private +let _ = 1 - 1 +private +let _ = 1 / 1 +private +let _ = 1 > 1 +private +let _ = 1 < 1 +private +let _ = 1 >= 1 +private +let _ = 1 <= 1 +] +Exports: [ +#set-options "--print_implicits" +let op_Plus x y = x, y +let op_Minus x y = x, y +let op_Slash x y = x, y +let op_Greater x y = x, y +let op_Less x y = x, y +let op_GreaterEquals x y = x, y +let op_LessEquals x y = x, y +private +let _ = 1 + 1 +private +let _ = 1 - 1 +private +let _ = 1 / 1 +private +let _ = 1 > 1 +private +let _ = 1 < 1 +private +let _ = 1 >= 1 +private +let _ = 1 <= 1 +] + +Module after type checking: +module Bug3292 +Declarations: [ +#set-options "--print_implicits" +let op_Plus #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_Minus #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_Slash #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_Greater #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_Less #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_GreaterEquals #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_LessEquals #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +private +let _ = Bug3292.op_Plus #Prims.int 1 1 +private +let _ = 1 - 1 +private +let _ = Bug3292.op_Slash #Prims.int 1 1 +private +let _ = Bug3292.op_Greater #Prims.int 1 1 +private +let _ = Bug3292.op_Less #Prims.int 1 1 +private +let _ = 1 >= 1 +private +let _ = 1 <= 1 +] +Exports: [ +#set-options "--print_implicits" +let op_Plus #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_Minus #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_Slash #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_Greater #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_Less #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_GreaterEquals #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_LessEquals #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +private +let _ = Bug3292.op_Plus #Prims.int 1 1 +private +let _ = 1 - 1 +private +let _ = Bug3292.op_Slash #Prims.int 1 1 +private +let _ = Bug3292.op_Greater #Prims.int 1 1 +private +let _ = Bug3292.op_Less #Prims.int 1 1 +private +let _ = 1 >= 1 +private +let _ = 1 <= 1 +] + +Verified module: Bug3292 +All verification conditions discharged successfully diff --git a/tests/error-messages/Makefile b/tests/error-messages/Makefile index 69d141cfced..325ea1fc27e 100644 --- a/tests/error-messages/Makefile +++ b/tests/error-messages/Makefile @@ -26,6 +26,7 @@ all: check-all Bug1997.fst.output: OTHERFLAGS+=--dump_module Bug1997 Bug2820.fst.output: OTHERFLAGS+=--dump_module Bug2820 Bug3227.fst.output: OTHERFLAGS+=--dump_module Bug3227 +Bug3292.fst.output: OTHERFLAGS+=--dump_module Bug3292 CalcImpl.fst.output: OTHERFLAGS+=--dump_module CalcImpl include $(FSTAR_HOME)/examples/Makefile.common From bd66193f0c88f179dddc65766d07318c66dab6fb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Thu, 16 May 2024 17:50:26 -0700 Subject: [PATCH 199/239] snap --- ocaml/fstar-lib/generated/FStar_Parser_AST.ml | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Parser_AST.ml b/ocaml/fstar-lib/generated/FStar_Parser_AST.ml index e9f0e558134..738743f4754 100644 --- a/ocaml/fstar-lib/generated/FStar_Parser_AST.ml +++ b/ocaml/fstar-lib/generated/FStar_Parser_AST.ml @@ -1665,7 +1665,8 @@ let (string_to_op : | "At" -> FStar_Pervasives_Native.Some ("@", FStar_Pervasives_Native.None) | "Plus" -> - FStar_Pervasives_Native.Some ("+", FStar_Pervasives_Native.None) + FStar_Pervasives_Native.Some + ("+", (FStar_Pervasives_Native.Some (Prims.of_int (2)))) | "Minus" -> FStar_Pervasives_Native.Some ("-", FStar_Pervasives_Native.None) | "Subtraction" -> @@ -1674,15 +1675,18 @@ let (string_to_op : | "Tilde" -> FStar_Pervasives_Native.Some ("~", FStar_Pervasives_Native.None) | "Slash" -> - FStar_Pervasives_Native.Some ("/", FStar_Pervasives_Native.None) + FStar_Pervasives_Native.Some + ("/", (FStar_Pervasives_Native.Some (Prims.of_int (2)))) | "Backslash" -> FStar_Pervasives_Native.Some ("\\", FStar_Pervasives_Native.None) | "Less" -> - FStar_Pervasives_Native.Some ("<", FStar_Pervasives_Native.None) + FStar_Pervasives_Native.Some + ("<", (FStar_Pervasives_Native.Some (Prims.of_int (2)))) | "Equals" -> FStar_Pervasives_Native.Some ("=", FStar_Pervasives_Native.None) | "Greater" -> - FStar_Pervasives_Native.Some (">", FStar_Pervasives_Native.None) + FStar_Pervasives_Native.Some + (">", (FStar_Pervasives_Native.Some (Prims.of_int (2)))) | "Underscore" -> FStar_Pervasives_Native.Some ("_", FStar_Pervasives_Native.None) | "Bar" -> From d9682fcc8ff277278591968fcf00ec292cf504ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 17 May 2024 10:52:48 -0700 Subject: [PATCH 200/239] Add pretty range instance --- src/basic/FStar.Compiler.Range.Ops.fst | 6 +++++- src/basic/FStar.Compiler.Range.Ops.fsti | 4 +++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/src/basic/FStar.Compiler.Range.Ops.fst b/src/basic/FStar.Compiler.Range.Ops.fst index b08a5ffe172..6cf7eb0afd8 100644 --- a/src/basic/FStar.Compiler.Range.Ops.fst +++ b/src/basic/FStar.Compiler.Range.Ops.fst @@ -121,6 +121,10 @@ let json_of_def_range r = (start_of_range r) (end_of_range r) -instance show_range = { +instance showable_range = { show = string_of_range; } + +instance pretty_range = { + pp = (fun r -> Pprint.doc_of_string (string_of_range r)); +} diff --git a/src/basic/FStar.Compiler.Range.Ops.fsti b/src/basic/FStar.Compiler.Range.Ops.fsti index 84f6500ddde..9ab5cda9b6f 100644 --- a/src/basic/FStar.Compiler.Range.Ops.fsti +++ b/src/basic/FStar.Compiler.Range.Ops.fsti @@ -18,6 +18,7 @@ module FStar.Compiler.Range.Ops open FStar.Compiler.Range.Type open FStar.Compiler.Effect open FStar.Class.Show +open FStar.Class.PP val union_rng: rng -> rng -> rng val union_ranges: range -> range -> range @@ -47,4 +48,5 @@ val json_of_pos : pos -> Json.json val json_of_use_range : range -> Json.json val json_of_def_range : range -> Json.json -instance val show_range : showable range +instance val showable_range : showable range +instance val pretty_range : pretty range From 59422b4f6d41eede90201899138de810697517ea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 17 May 2024 14:10:33 -0700 Subject: [PATCH 201/239] Makefile: post a warning about `make boot` --- Makefile | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/Makefile b/Makefile index d8510ef23f2..1e820f2973b 100644 --- a/Makefile +++ b/Makefile @@ -57,6 +57,11 @@ bootstrap: +$(Q)$(MAKE) dune-snapshot +$(Q)$(MAKE) fstar +# This is a faster version of bootstrap, since it does not use dune +# to install the binary and libraries, and instead just copies the binary +# mannualy. HOWEVER, note that this means plugins will not work well, +# since they are compiled against the objects in bin/, which will become +# stale if this rule is used. Using bootstrap is usually safer. .PHONY: boot boot: +$(Q)$(MAKE) dune-snapshot From 9ce628f5e1a4e583df4a53953b4d7a1d7b040011 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 17 May 2024 14:25:37 -0700 Subject: [PATCH 202/239] Typeclasses: solve trivial unit goals too They may show up if instances happened to add a unit argument, like: instance val has_range_syntax #a : unit -> Tot (hasRange (syntax a)) while it is really there for no reason (it's a pure definition anyway), the resolution tactic should not be broken by such things. --- ulib/FStar.Tactics.Typeclasses.fst | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/ulib/FStar.Tactics.Typeclasses.fst b/ulib/FStar.Tactics.Typeclasses.fst index d6b21d4199d..973030175c5 100644 --- a/ulib/FStar.Tactics.Typeclasses.fst +++ b/ulib/FStar.Tactics.Typeclasses.fst @@ -219,6 +219,19 @@ let global (st:st_t) (g:tc_goal) (k : st_t -> Tac unit) () : Tac unit = trywith st g (pack (Tv_FVar fv)) typ k) st.glb +exception Next +let try_trivial (st:st_t) (g:tc_goal) (k : st_t -> Tac unit) () : Tac unit = + match g.g with + | Tv_FVar fv -> + if implode_qn (inspect_fv fv) = `%unit + then exact (`()) + else raise Next + | _ -> raise Next + +let ( <|> ) (t1 t2 : unit -> Tac 'a) : unit -> Tac 'a = + fun () -> + try t1 () with _ -> t2 () + (* tcresolve': the main typeclass instantiation function. @@ -254,7 +267,9 @@ let rec tcresolve' (st:st_t) : Tac unit = let args_and_uvars = args |> Util.map (fun (a, q) -> (a, q), Cons? (free_uvars a )) in let st = { st with seen = g :: st.seen } in let g = { g; head_fv; c_se; fundeps; args_and_uvars } in - local st g tcresolve' `or_else` global st g tcresolve' + (try_trivial st g tcresolve' <|> + local st g tcresolve' <|> + global st g tcresolve') () let rec concatMap (f : 'a -> Tac (list 'b)) (l : list 'a) : Tac (list 'b) = match l with From d3c64129eb1e73fecba98863f0dbeb722b463fd2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 17 May 2024 14:27:04 -0700 Subject: [PATCH 203/239] Typeclasses: nits on error messages --- ulib/FStar.Tactics.Typeclasses.fst | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ulib/FStar.Tactics.Typeclasses.fst b/ulib/FStar.Tactics.Typeclasses.fst index 973030175c5..69bb508a2ed 100644 --- a/ulib/FStar.Tactics.Typeclasses.fst +++ b/ulib/FStar.Tactics.Typeclasses.fst @@ -306,12 +306,12 @@ let tcresolve () : Tac unit = | NoInst -> let open FStar.Stubs.Pprint in fail_doc [ - text "Typeclass resolution failed"; + text "Typeclass resolution failed."; prefix 2 1 (text "Could not solve constraint") - (arbitrary_string (term_to_string (cur_goal ()))); + (term_to_doc (cur_goal ())); ] | TacticFailure msg -> - fail_doc ([text "Typeclass resolution failed"] @ msg) + fail_doc ([text "Typeclass resolution failed."] @ msg) | e -> raise e (**** Generating methods from a class ****) From be7f2cf0d866c95085c7c50ba16ebefbc36619f4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 17 May 2024 14:27:45 -0700 Subject: [PATCH 204/239] Tactics: nit, typeclass now resolves automatically --- src/tactics/FStar.Tactics.V2.Basic.fst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tactics/FStar.Tactics.V2.Basic.fst b/src/tactics/FStar.Tactics.V2.Basic.fst index e31b541229b..453c35f1e2b 100644 --- a/src/tactics/FStar.Tactics.V2.Basic.fst +++ b/src/tactics/FStar.Tactics.V2.Basic.fst @@ -578,7 +578,7 @@ let tadmit_t (t:term) : tac unit = wrap_err "tadmit_t" <| ( let! ps = get in let! g = cur_goal in // should somehow taint the state instead of just printing a warning - Err.log_issue (pos #_ #(has_range_syntax ()) (goal_type g)) + Err.log_issue (pos (goal_type g)) (Errors.Warning_TacAdmit, BU.format1 "Tactics admitted goal <%s>\n\n" (goal_to_string "" None ps g)); solve' g t) From bcb895664e179972b6abbb3801be473d0a47e82e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 17 May 2024 14:35:02 -0700 Subject: [PATCH 205/239] Typeclasses: add a test --- tests/typeclasses/Unit.fst | 7 +++++++ 1 file changed, 7 insertions(+) create mode 100644 tests/typeclasses/Unit.fst diff --git a/tests/typeclasses/Unit.fst b/tests/typeclasses/Unit.fst new file mode 100644 index 00000000000..8d3ec68915e --- /dev/null +++ b/tests/typeclasses/Unit.fst @@ -0,0 +1,7 @@ +module Unit + +class c (t:Type) = { dummy:unit } + +instance c_int () : c int = { dummy=() } + +let _ : c int = Tactics.Typeclasses.solve From 8d41c2e292fd6cd32ad23b02839ec2ecd89f5119 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 17 May 2024 14:46:31 -0700 Subject: [PATCH 206/239] Resugaring: canonicalize applications before checking for projectors Related to #3227. Without this, this rule does not kick in for Pulse for any parametrized type, as the applications are nested. --- src/syntax/FStar.Syntax.Resugar.fst | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/syntax/FStar.Syntax.Resugar.fst b/src/syntax/FStar.Syntax.Resugar.fst index fd1857093a4..fc944263ea0 100644 --- a/src/syntax/FStar.Syntax.Resugar.fst +++ b/src/syntax/FStar.Syntax.Resugar.fst @@ -411,7 +411,11 @@ let rec resugar_term' (env: DsEnv.env) (t : S.term) : A.term = when can_resugar_machine_integer fv -> resugar_machine_integer fv i t.pos - | Tm_app {hd=e; args} -> + | Tm_app _ -> + let t = U.canon_app t in + let Tm_app {hd=e; args} = t.n in + (* NB: This cannot fail since U.canon_app constructs a Tm_app. *) + (* Op("=!=", args) is desugared into Op("~", Op("==") and not resugared back as "=!=" *) let rec last = function | hd :: [] -> [hd] From bc1102b9d8e2ab80a9b077aec3a92fddb9829bd7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 17 May 2024 14:51:54 -0700 Subject: [PATCH 207/239] snap --- .../generated/FStar_Compiler_Range_Ops.ml | 11 +- .../FStar_SMTEncoding_ErrorReporting.ml | 2 +- .../generated/FStar_SMTEncoding_Solver.ml | 2 +- .../generated/FStar_Syntax_Resugar.ml | 1013 +++++++++-------- .../generated/FStar_Tactics_Typeclasses.ml | 872 +++++++------- .../generated/FStar_Tactics_V1_Basic.ml | 7 +- .../generated/FStar_Tactics_V2_Basic.ml | 14 +- .../generated/FStar_TypeChecker_Generalize.ml | 2 +- .../FStar_TypeChecker_Normalize_Unfolding.ml | 4 +- .../generated/FStar_TypeChecker_TcTerm.ml | 6 +- 10 files changed, 1007 insertions(+), 926 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Compiler_Range_Ops.ml b/ocaml/fstar-lib/generated/FStar_Compiler_Range_Ops.ml index a0c0ef1c24a..16520664139 100644 --- a/ocaml/fstar-lib/generated/FStar_Compiler_Range_Ops.ml +++ b/ocaml/fstar-lib/generated/FStar_Compiler_Range_Ops.ml @@ -255,5 +255,12 @@ let (json_of_def_range : FStar_Compiler_Range_Type.range -> FStar_Json.json) let uu___ = file_of_range r in let uu___1 = start_of_range r in let uu___2 = end_of_range r in json_of_range_fields uu___ uu___1 uu___2 -let (show_range : FStar_Compiler_Range_Type.range FStar_Class_Show.showable) - = { FStar_Class_Show.show = string_of_range } \ No newline at end of file +let (showable_range : + FStar_Compiler_Range_Type.range FStar_Class_Show.showable) = + { FStar_Class_Show.show = string_of_range } +let (pretty_range : FStar_Compiler_Range_Type.range FStar_Class_PP.pretty) = + { + FStar_Class_PP.pp = + (fun r -> + let uu___ = string_of_range r in FStar_Pprint.doc_of_string uu___) + } \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_ErrorReporting.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_ErrorReporting.ml index b3897210935..232b6a12447 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_ErrorReporting.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_ErrorReporting.ml @@ -812,7 +812,7 @@ let (detail_errors : let uu___8 = let uu___9 = FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range r in + FStar_Compiler_Range_Ops.showable_range r in FStar_Compiler_Util.format1 "XX: proof obligation at %s failed." uu___9 in FStar_Errors_Msg.text uu___8 in diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml index 51ea5b6039b..9aa4beca0e8 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml @@ -1066,7 +1066,7 @@ let (query_info : query_settings -> FStar_SMTEncoding_Z3.z3result -> unit) = let uu___3 = let uu___4 = FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range + FStar_Compiler_Range_Ops.showable_range settings.query_range in Prims.strcat uu___4 (Prims.strcat at_log_file ")") in Prims.strcat "(" uu___3 in diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml index 3931c66662e..1eb2e13fc41 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml @@ -756,506 +756,541 @@ let rec (resugar_term' : uu___7)::[];_} when can_resugar_machine_integer fv -> resugar_machine_integer fv i t.FStar_Syntax_Syntax.pos - | FStar_Syntax_Syntax.Tm_app - { FStar_Syntax_Syntax.hd = e; FStar_Syntax_Syntax.args = args;_} -> - let rec last uu___1 = - match uu___1 with - | hd::[] -> [hd] - | hd::tl -> last tl - | uu___2 -> - FStar_Compiler_Effect.failwith "last of an empty list" in - let first_two_explicit args1 = - let rec drop_implicits args2 = - match args2 with - | (uu___1, FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.aqual_implicit = true; - FStar_Syntax_Syntax.aqual_attributes = uu___2;_})::tl - -> drop_implicits tl - | uu___1 -> args2 in - let uu___1 = drop_implicits args1 in - match uu___1 with - | [] -> - FStar_Compiler_Effect.failwith - "not_enough explicit_arguments" - | uu___2::[] -> - FStar_Compiler_Effect.failwith - "not_enough explicit_arguments" - | a1::a2::uu___2 -> [a1; a2] in - let resugar_as_app e1 args1 = - let args2 = - FStar_Compiler_List.map - (fun uu___1 -> - match uu___1 with - | (e2, qual) -> - let uu___2 = resugar_term' env e2 in - let uu___3 = resugar_aqual env qual in - (uu___2, uu___3)) args1 in - let uu___1 = resugar_term' env e1 in - match uu___1 with - | { - FStar_Parser_AST.tm = FStar_Parser_AST.Construct - (hd, previous_args); - FStar_Parser_AST.range = r; FStar_Parser_AST.level = l;_} -> - FStar_Parser_AST.mk_term - (FStar_Parser_AST.Construct - (hd, (FStar_Compiler_List.op_At previous_args args2))) r - l - | e2 -> - FStar_Compiler_List.fold_left - (fun acc -> - fun uu___2 -> - match uu___2 with - | (x, qual) -> - mk (FStar_Parser_AST.App (acc, x, qual))) e2 args2 in - let args1 = - let uu___1 = FStar_Options.print_implicits () in - if uu___1 then args else filter_imp_args args in - let is_projector t1 = - let uu___1 = - let uu___2 = - let uu___3 = FStar_Syntax_Subst.compress t1 in - FStar_Syntax_Util.un_uinst uu___3 in - uu___2.FStar_Syntax_Syntax.n in - match uu___1 with - | FStar_Syntax_Syntax.Tm_fvar fv -> - let a = - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - let length = - let uu___2 = - FStar_Ident.nsstr - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - FStar_Compiler_String.length uu___2 in - let s = - if length = Prims.int_zero - then FStar_Ident.string_of_lid a - else - (let uu___3 = FStar_Ident.string_of_lid a in - FStar_Compiler_Util.substring_from uu___3 - (length + Prims.int_one)) in - if - FStar_Compiler_Util.starts_with s - FStar_Syntax_Util.field_projector_prefix - then - let rest = - FStar_Compiler_Util.substring_from s - (FStar_Compiler_String.length - FStar_Syntax_Util.field_projector_prefix) in - let r = - FStar_Compiler_Util.split rest - FStar_Syntax_Util.field_projector_sep in - (match r with - | fst::snd::[] -> - let l = - FStar_Ident.lid_of_path [fst] - t1.FStar_Syntax_Syntax.pos in - let r1 = - FStar_Ident.mk_ident - (snd, (t1.FStar_Syntax_Syntax.pos)) in - FStar_Pervasives_Native.Some (l, r1) - | uu___2 -> - FStar_Compiler_Effect.failwith - "wrong projector format") - else FStar_Pervasives_Native.None - | uu___2 -> FStar_Pervasives_Native.None in - let uu___1 = - (let uu___2 = is_projector e in - FStar_Pervasives_Native.uu___is_Some uu___2) && - ((FStar_Compiler_List.length args1) = Prims.int_one) in - if uu___1 - then - let uu___2 = - let uu___3 = is_projector e in - FStar_Pervasives_Native.__proj__Some__item__v uu___3 in - (match uu___2 with - | (uu___3, fi) -> - let arg = + | FStar_Syntax_Syntax.Tm_app uu___1 -> + let t1 = FStar_Syntax_Util.canon_app t in + let uu___2 = t1.FStar_Syntax_Syntax.n in + (match uu___2 with + | FStar_Syntax_Syntax.Tm_app + { FStar_Syntax_Syntax.hd = e; + FStar_Syntax_Syntax.args = args;_} + -> + let rec last uu___3 = + match uu___3 with + | hd::[] -> [hd] + | hd::tl -> last tl + | uu___4 -> + FStar_Compiler_Effect.failwith "last of an empty list" in + let first_two_explicit args1 = + let rec drop_implicits args2 = + match args2 with + | (uu___3, FStar_Pervasives_Native.Some + { FStar_Syntax_Syntax.aqual_implicit = true; + FStar_Syntax_Syntax.aqual_attributes = uu___4;_})::tl + -> drop_implicits tl + | uu___3 -> args2 in + let uu___3 = drop_implicits args1 in + match uu___3 with + | [] -> + FStar_Compiler_Effect.failwith + "not_enough explicit_arguments" + | uu___4::[] -> + FStar_Compiler_Effect.failwith + "not_enough explicit_arguments" + | a1::a2::uu___4 -> [a1; a2] in + let resugar_as_app e1 args1 = + let args2 = + FStar_Compiler_List.map + (fun uu___3 -> + match uu___3 with + | (e2, qual) -> + let uu___4 = resugar_term' env e2 in + let uu___5 = resugar_aqual env qual in + (uu___4, uu___5)) args1 in + let uu___3 = resugar_term' env e1 in + match uu___3 with + | { + FStar_Parser_AST.tm = FStar_Parser_AST.Construct + (hd, previous_args); + FStar_Parser_AST.range = r; + FStar_Parser_AST.level = l;_} -> + FStar_Parser_AST.mk_term + (FStar_Parser_AST.Construct + (hd, + (FStar_Compiler_List.op_At previous_args args2))) + r l + | e2 -> + FStar_Compiler_List.fold_left + (fun acc -> + fun uu___4 -> + match uu___4 with + | (x, qual) -> + mk (FStar_Parser_AST.App (acc, x, qual))) e2 + args2 in + let args1 = + let uu___3 = FStar_Options.print_implicits () in + if uu___3 then args else filter_imp_args args in + let is_projector t2 = + let uu___3 = let uu___4 = - let uu___5 = FStar_Compiler_List.hd args1 in - FStar_Pervasives_Native.fst uu___5 in - resugar_term' env uu___4 in + let uu___5 = FStar_Syntax_Subst.compress t2 in + FStar_Syntax_Util.un_uinst uu___5 in + uu___4.FStar_Syntax_Syntax.n in + match uu___3 with + | FStar_Syntax_Syntax.Tm_fvar fv -> + let a = + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + let length = + let uu___4 = + FStar_Ident.nsstr + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + FStar_Compiler_String.length uu___4 in + let s = + if length = Prims.int_zero + then FStar_Ident.string_of_lid a + else + (let uu___5 = FStar_Ident.string_of_lid a in + FStar_Compiler_Util.substring_from uu___5 + (length + Prims.int_one)) in + if + FStar_Compiler_Util.starts_with s + FStar_Syntax_Util.field_projector_prefix + then + let rest = + FStar_Compiler_Util.substring_from s + (FStar_Compiler_String.length + FStar_Syntax_Util.field_projector_prefix) in + let r = + FStar_Compiler_Util.split rest + FStar_Syntax_Util.field_projector_sep in + (match r with + | fst::snd::[] -> + let l = + FStar_Ident.lid_of_path [fst] + t2.FStar_Syntax_Syntax.pos in + let r1 = + FStar_Ident.mk_ident + (snd, (t2.FStar_Syntax_Syntax.pos)) in + FStar_Pervasives_Native.Some (l, r1) + | uu___4 -> + FStar_Compiler_Effect.failwith + "wrong projector format") + else FStar_Pervasives_Native.None + | uu___4 -> FStar_Pervasives_Native.None in + let uu___3 = + (let uu___4 = is_projector e in + FStar_Pervasives_Native.uu___is_Some uu___4) && + ((FStar_Compiler_List.length args1) = Prims.int_one) in + if uu___3 + then let uu___4 = - let uu___5 = - let uu___6 = FStar_Ident.lid_of_ids [fi] in - (arg, uu___6) in - FStar_Parser_AST.Project uu___5 in - mk uu___4) - else - (let uu___3 = resugar_term_as_op e in - match uu___3 with - | FStar_Pervasives_Native.None -> resugar_as_app e args1 - | FStar_Pervasives_Native.Some ("calc_finish", uu___4) -> - let uu___5 = resugar_calc env t in - (match uu___5 with - | FStar_Pervasives_Native.Some r -> r - | uu___6 -> resugar_as_app e args1) - | FStar_Pervasives_Native.Some ("tuple", uu___4) -> - let out = - FStar_Compiler_List.fold_left - (fun out1 -> - fun uu___5 -> - match uu___5 with - | (x, uu___6) -> - let x1 = resugar_term' env x in - (match out1 with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.Some x1 - | FStar_Pervasives_Native.Some prefix -> - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = - FStar_Ident.id_of_text "*" in - (uu___10, [prefix; x1]) in - FStar_Parser_AST.Op uu___9 in - mk uu___8 in - FStar_Pervasives_Native.Some uu___7)) - FStar_Pervasives_Native.None args1 in - FStar_Compiler_Option.get out - | FStar_Pervasives_Native.Some ("dtuple", uu___4) -> - resugar_as_app e args1 - | FStar_Pervasives_Native.Some (ref_read, uu___4) when - let uu___5 = - FStar_Ident.string_of_lid FStar_Parser_Const.sread_lid in - ref_read = uu___5 -> - let uu___5 = FStar_Compiler_List.hd args1 in - (match uu___5 with - | (t1, uu___6) -> + let uu___5 = is_projector e in + FStar_Pervasives_Native.__proj__Some__item__v uu___5 in + (match uu___4 with + | (uu___5, fi) -> + let arg = + let uu___6 = + let uu___7 = FStar_Compiler_List.hd args1 in + FStar_Pervasives_Native.fst uu___7 in + resugar_term' env uu___6 in + let uu___6 = + let uu___7 = + let uu___8 = FStar_Ident.lid_of_ids [fi] in + (arg, uu___8) in + FStar_Parser_AST.Project uu___7 in + mk uu___6) + else + (let uu___5 = resugar_term_as_op e in + match uu___5 with + | FStar_Pervasives_Native.None -> resugar_as_app e args1 + | FStar_Pervasives_Native.Some ("calc_finish", uu___6) -> + let uu___7 = resugar_calc env t1 in + (match uu___7 with + | FStar_Pervasives_Native.Some r -> r + | uu___8 -> resugar_as_app e args1) + | FStar_Pervasives_Native.Some ("tuple", uu___6) -> + let out = + FStar_Compiler_List.fold_left + (fun out1 -> + fun uu___7 -> + match uu___7 with + | (x, uu___8) -> + let x1 = resugar_term' env x in + (match out1 with + | FStar_Pervasives_Native.None -> + FStar_Pervasives_Native.Some x1 + | FStar_Pervasives_Native.Some prefix -> + let uu___9 = + let uu___10 = + let uu___11 = + let uu___12 = + FStar_Ident.id_of_text "*" in + (uu___12, [prefix; x1]) in + FStar_Parser_AST.Op uu___11 in + mk uu___10 in + FStar_Pervasives_Native.Some uu___9)) + FStar_Pervasives_Native.None args1 in + FStar_Compiler_Option.get out + | FStar_Pervasives_Native.Some ("dtuple", uu___6) -> + resugar_as_app e args1 + | FStar_Pervasives_Native.Some (ref_read, uu___6) when let uu___7 = - let uu___8 = FStar_Syntax_Subst.compress t1 in - uu___8.FStar_Syntax_Syntax.n in + FStar_Ident.string_of_lid + FStar_Parser_Const.sread_lid in + ref_read = uu___7 -> + let uu___7 = FStar_Compiler_List.hd args1 in (match uu___7 with - | FStar_Syntax_Syntax.Tm_fvar fv when - let uu___8 = - FStar_Ident.string_of_lid - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - FStar_Syntax_Util.field_projector_contains_constructor - uu___8 - -> - let f = - let uu___8 = - let uu___9 = - FStar_Ident.string_of_lid - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - [uu___9] in - FStar_Ident.lid_of_path uu___8 - t1.FStar_Syntax_Syntax.pos in - let uu___8 = - let uu___9 = - let uu___10 = resugar_term' env t1 in - (uu___10, f) in - FStar_Parser_AST.Project uu___9 in - mk uu___8 - | uu___8 -> resugar_term' env t1)) - | FStar_Pervasives_Native.Some ("try_with", uu___4) when - (FStar_Compiler_List.length args1) > Prims.int_one -> - (try - (fun uu___5 -> - match () with - | () -> - let new_args = first_two_explicit args1 in - let uu___6 = - match new_args with - | (a1, uu___7)::(a2, uu___8)::[] -> (a1, a2) - | uu___7 -> - FStar_Compiler_Effect.failwith - "wrong arguments to try_with" in - (match uu___6 with - | (body, handler) -> - let decomp term = - let uu___7 = - let uu___8 = - FStar_Syntax_Subst.compress term in - uu___8.FStar_Syntax_Syntax.n in - match uu___7 with - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = x; - FStar_Syntax_Syntax.body = e1; - FStar_Syntax_Syntax.rc_opt = uu___8;_} - -> - let uu___9 = - FStar_Syntax_Subst.open_term x e1 in - (match uu___9 with | (x1, e2) -> e2) - | uu___8 -> - let uu___9 = - let uu___10 = - let uu___11 = - resugar_term' env term in - FStar_Parser_AST.term_to_string - uu___11 in - Prims.strcat - "wrong argument format to try_with: " - uu___10 in - FStar_Compiler_Effect.failwith uu___9 in - let body1 = - let uu___7 = decomp body in - resugar_term' env uu___7 in - let handler1 = - let uu___7 = decomp handler in - resugar_term' env uu___7 in - let rec resugar_body t1 = - match t1.FStar_Parser_AST.tm with - | FStar_Parser_AST.Match - (e1, FStar_Pervasives_Native.None, - FStar_Pervasives_Native.None, - (uu___7, uu___8, b)::[]) - -> b - | FStar_Parser_AST.Let (uu___7, uu___8, b) - -> b - | FStar_Parser_AST.Ascribed - (t11, t2, t3, use_eq) -> - let uu___7 = - let uu___8 = - let uu___9 = resugar_body t11 in - (uu___9, t2, t3, use_eq) in - FStar_Parser_AST.Ascribed uu___8 in - mk uu___7 - | uu___7 -> - FStar_Compiler_Effect.failwith - "unexpected body format to try_with" in - let e1 = resugar_body body1 in - let rec resugar_branches t1 = - match t1.FStar_Parser_AST.tm with - | FStar_Parser_AST.Match - (e2, FStar_Pervasives_Native.None, - FStar_Pervasives_Native.None, - branches) - -> branches - | FStar_Parser_AST.Ascribed - (t11, t2, t3, uu___7) -> - resugar_branches t11 - | uu___7 -> [] in - let branches = resugar_branches handler1 in - mk (FStar_Parser_AST.TryWith (e1, branches)))) - () - with | uu___5 -> resugar_as_app e args1) - | FStar_Pervasives_Native.Some ("try_with", uu___4) -> - resugar_as_app e args1 - | FStar_Pervasives_Native.Some (op, uu___4) when - (((((((op = "=") || (op = "==")) || (op = "===")) || - (op = "@")) - || (op = ":=")) - || (op = "|>")) - || (op = "<<")) - && (FStar_Options.print_implicits ()) - -> resugar_as_app e args1 - | FStar_Pervasives_Native.Some (op, uu___4) when - (FStar_Compiler_Util.starts_with op "forall") || - (FStar_Compiler_Util.starts_with op "exists") - -> - let rec uncurry xs pats t1 flavor_matches = - match t1.FStar_Parser_AST.tm with - | FStar_Parser_AST.QExists (xs', (uu___5, pats'), body) - when flavor_matches t1 -> - uncurry (FStar_Compiler_List.op_At xs xs') - (FStar_Compiler_List.op_At pats pats') body - flavor_matches - | FStar_Parser_AST.QForall (xs', (uu___5, pats'), body) - when flavor_matches t1 -> - uncurry (FStar_Compiler_List.op_At xs xs') - (FStar_Compiler_List.op_At pats pats') body - flavor_matches - | FStar_Parser_AST.QuantOp - (uu___5, xs', (uu___6, pats'), body) when - flavor_matches t1 -> - uncurry (FStar_Compiler_List.op_At xs xs') - (FStar_Compiler_List.op_At pats pats') body - flavor_matches - | uu___5 -> (xs, pats, t1) in - let resugar_forall_body body = - let uu___5 = - let uu___6 = FStar_Syntax_Subst.compress body in - uu___6.FStar_Syntax_Syntax.n in - match uu___5 with - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = xs; - FStar_Syntax_Syntax.body = body1; - FStar_Syntax_Syntax.rc_opt = uu___6;_} - -> - let uu___7 = FStar_Syntax_Subst.open_term xs body1 in - (match uu___7 with - | (xs1, body2) -> - let xs2 = - let uu___8 = FStar_Options.print_implicits () in - if uu___8 then xs1 else filter_imp_bs xs1 in - let xs3 = - (map_opt ()) - (fun b -> - resugar_binder' env b - t.FStar_Syntax_Syntax.pos) xs2 in - let uu___8 = - let uu___9 = + | (t2, uu___8) -> + let uu___9 = + let uu___10 = FStar_Syntax_Subst.compress t2 in + uu___10.FStar_Syntax_Syntax.n in + (match uu___9 with + | FStar_Syntax_Syntax.Tm_fvar fv when let uu___10 = - FStar_Syntax_Subst.compress body2 in - uu___10.FStar_Syntax_Syntax.n in - match uu___9 with - | FStar_Syntax_Syntax.Tm_meta - { FStar_Syntax_Syntax.tm2 = e1; - FStar_Syntax_Syntax.meta = m;_} - -> - let body3 = resugar_term' env e1 in + FStar_Ident.string_of_lid + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + FStar_Syntax_Util.field_projector_contains_constructor + uu___10 + -> + let f = let uu___10 = - match m with - | FStar_Syntax_Syntax.Meta_pattern - (uu___11, pats) -> - let uu___12 = - FStar_Compiler_List.map - (fun es -> + let uu___11 = + FStar_Ident.string_of_lid + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + [uu___11] in + FStar_Ident.lid_of_path uu___10 + t2.FStar_Syntax_Syntax.pos in + let uu___10 = + let uu___11 = + let uu___12 = resugar_term' env t2 in + (uu___12, f) in + FStar_Parser_AST.Project uu___11 in + mk uu___10 + | uu___10 -> resugar_term' env t2)) + | FStar_Pervasives_Native.Some ("try_with", uu___6) when + (FStar_Compiler_List.length args1) > Prims.int_one -> + (try + (fun uu___7 -> + match () with + | () -> + let new_args = first_two_explicit args1 in + let uu___8 = + match new_args with + | (a1, uu___9)::(a2, uu___10)::[] -> + (a1, a2) + | uu___9 -> + FStar_Compiler_Effect.failwith + "wrong arguments to try_with" in + (match uu___8 with + | (body, handler) -> + let decomp term = + let uu___9 = + let uu___10 = + FStar_Syntax_Subst.compress term in + uu___10.FStar_Syntax_Syntax.n in + match uu___9 with + | FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = x; + FStar_Syntax_Syntax.body = e1; + FStar_Syntax_Syntax.rc_opt = + uu___10;_} + -> + let uu___11 = + FStar_Syntax_Subst.open_term x + e1 in + (match uu___11 with + | (x1, e2) -> e2) + | uu___10 -> + let uu___11 = + let uu___12 = + let uu___13 = + resugar_term' env term in + FStar_Parser_AST.term_to_string + uu___13 in + Prims.strcat + "wrong argument format to try_with: " + uu___12 in + FStar_Compiler_Effect.failwith + uu___11 in + let body1 = + let uu___9 = decomp body in + resugar_term' env uu___9 in + let handler1 = + let uu___9 = decomp handler in + resugar_term' env uu___9 in + let rec resugar_body t2 = + match t2.FStar_Parser_AST.tm with + | FStar_Parser_AST.Match + (e1, FStar_Pervasives_Native.None, + FStar_Pervasives_Native.None, + (uu___9, uu___10, b)::[]) + -> b + | FStar_Parser_AST.Let + (uu___9, uu___10, b) -> b + | FStar_Parser_AST.Ascribed + (t11, t21, t3, use_eq) -> + let uu___9 = + let uu___10 = + let uu___11 = resugar_body t11 in + (uu___11, t21, t3, use_eq) in + FStar_Parser_AST.Ascribed + uu___10 in + mk uu___9 + | uu___9 -> + FStar_Compiler_Effect.failwith + "unexpected body format to try_with" in + let e1 = resugar_body body1 in + let rec resugar_branches t2 = + match t2.FStar_Parser_AST.tm with + | FStar_Parser_AST.Match + (e2, FStar_Pervasives_Native.None, + FStar_Pervasives_Native.None, + branches) + -> branches + | FStar_Parser_AST.Ascribed + (t11, t21, t3, uu___9) -> + resugar_branches t11 + | uu___9 -> [] in + let branches = resugar_branches handler1 in + mk + (FStar_Parser_AST.TryWith + (e1, branches)))) () + with | uu___7 -> resugar_as_app e args1) + | FStar_Pervasives_Native.Some ("try_with", uu___6) -> + resugar_as_app e args1 + | FStar_Pervasives_Native.Some (op, uu___6) when + (((((((op = "=") || (op = "==")) || (op = "===")) || + (op = "@")) + || (op = ":=")) + || (op = "|>")) + || (op = "<<")) + && (FStar_Options.print_implicits ()) + -> resugar_as_app e args1 + | FStar_Pervasives_Native.Some (op, uu___6) when + (FStar_Compiler_Util.starts_with op "forall") || + (FStar_Compiler_Util.starts_with op "exists") + -> + let rec uncurry xs pats t2 flavor_matches = + match t2.FStar_Parser_AST.tm with + | FStar_Parser_AST.QExists + (xs', (uu___7, pats'), body) when + flavor_matches t2 -> + uncurry (FStar_Compiler_List.op_At xs xs') + (FStar_Compiler_List.op_At pats pats') body + flavor_matches + | FStar_Parser_AST.QForall + (xs', (uu___7, pats'), body) when + flavor_matches t2 -> + uncurry (FStar_Compiler_List.op_At xs xs') + (FStar_Compiler_List.op_At pats pats') body + flavor_matches + | FStar_Parser_AST.QuantOp + (uu___7, xs', (uu___8, pats'), body) when + flavor_matches t2 -> + uncurry (FStar_Compiler_List.op_At xs xs') + (FStar_Compiler_List.op_At pats pats') body + flavor_matches + | uu___7 -> (xs, pats, t2) in + let resugar_forall_body body = + let uu___7 = + let uu___8 = FStar_Syntax_Subst.compress body in + uu___8.FStar_Syntax_Syntax.n in + match uu___7 with + | FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = xs; + FStar_Syntax_Syntax.body = body1; + FStar_Syntax_Syntax.rc_opt = uu___8;_} + -> + let uu___9 = + FStar_Syntax_Subst.open_term xs body1 in + (match uu___9 with + | (xs1, body2) -> + let xs2 = + let uu___10 = + FStar_Options.print_implicits () in + if uu___10 then xs1 else filter_imp_bs xs1 in + let xs3 = + (map_opt ()) + (fun b -> + resugar_binder' env b + t1.FStar_Syntax_Syntax.pos) xs2 in + let uu___10 = + let uu___11 = + let uu___12 = + FStar_Syntax_Subst.compress body2 in + uu___12.FStar_Syntax_Syntax.n in + match uu___11 with + | FStar_Syntax_Syntax.Tm_meta + { FStar_Syntax_Syntax.tm2 = e1; + FStar_Syntax_Syntax.meta = m;_} + -> + let body3 = resugar_term' env e1 in + let uu___12 = + match m with + | FStar_Syntax_Syntax.Meta_pattern + (uu___13, pats) -> + let uu___14 = FStar_Compiler_List.map - (fun uu___13 -> - match uu___13 with - | (e2, uu___14) -> - resugar_term' env e2) - es) pats in - (uu___12, body3) - | FStar_Syntax_Syntax.Meta_labeled - (s, r, p) -> - let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = - FStar_Errors_Msg.rendermsg s in - (body3, uu___14, p) in - FStar_Parser_AST.Labeled uu___13 in - mk uu___12 in - ([], uu___11) - | uu___11 -> - FStar_Compiler_Effect.failwith - "wrong pattern format for QForall/QExists" in - (match uu___10 with - | (pats, body4) -> (pats, body4)) - | uu___10 -> - let uu___11 = resugar_term' env body2 in - ([], uu___11) in - (match uu___8 with - | (pats, body3) -> - let decompile_op op1 = - let uu___9 = - FStar_Parser_AST.string_to_op op1 in - match uu___9 with - | FStar_Pervasives_Native.None -> op1 - | FStar_Pervasives_Native.Some - (op2, uu___10) -> op2 in - let flavor_matches t1 = - match ((t1.FStar_Parser_AST.tm), op) with - | (FStar_Parser_AST.QExists uu___9, - "exists") -> true - | (FStar_Parser_AST.QForall uu___9, - "forall") -> true - | (FStar_Parser_AST.QuantOp - (id, uu___9, uu___10, uu___11), - uu___12) -> - let uu___13 = - FStar_Ident.string_of_id id in - uu___13 = op - | uu___9 -> false in - let uu___9 = - uncurry xs3 pats body3 flavor_matches in - (match uu___9 with - | (xs4, pats1, body4) -> - let binders = - FStar_Parser_AST.idents_of_binders - xs4 t.FStar_Syntax_Syntax.pos in - if op = "forall" - then - mk - (FStar_Parser_AST.QForall - (xs4, (binders, pats1), body4)) - else - if op = "exists" - then - mk - (FStar_Parser_AST.QExists - (xs4, (binders, pats1), body4)) - else - (let uu___12 = + (fun es -> + FStar_Compiler_List.map + (fun uu___15 -> + match uu___15 with + | (e2, uu___16) -> + resugar_term' + env e2) es) + pats in + (uu___14, body3) + | FStar_Syntax_Syntax.Meta_labeled + (s, r, p) -> let uu___13 = let uu___14 = - FStar_Ident.id_of_text op in - (uu___14, xs4, - (binders, pats1), body4) in - FStar_Parser_AST.QuantOp uu___13 in - mk uu___12)))) - | uu___6 -> - if op = "forall" - then - let uu___7 = - let uu___8 = - let uu___9 = resugar_term' env body in - ([], ([], []), uu___9) in - FStar_Parser_AST.QForall uu___8 in - mk uu___7 - else - (let uu___8 = - let uu___9 = - let uu___10 = resugar_term' env body in - ([], ([], []), uu___10) in - FStar_Parser_AST.QExists uu___9 in - mk uu___8) in - if (FStar_Compiler_List.length args1) > Prims.int_zero - then - let args2 = last args1 in - (match args2 with - | (b, uu___5)::[] -> resugar_forall_body b - | uu___5 -> - FStar_Compiler_Effect.failwith - "wrong args format to QForall") - else resugar_as_app e args1 - | FStar_Pervasives_Native.Some ("alloc", uu___4) -> - let uu___5 = FStar_Compiler_List.hd args1 in - (match uu___5 with | (e1, uu___6) -> resugar_term' env e1) - | FStar_Pervasives_Native.Some (op, expected_arity1) -> - let op1 = FStar_Ident.id_of_text op in - let resugar args2 = - FStar_Compiler_List.map - (fun uu___4 -> - match uu___4 with - | (e1, qual) -> - let uu___5 = resugar_term' env e1 in - let uu___6 = resugar_aqual env qual in - (uu___5, uu___6)) args2 in - (match expected_arity1 with - | FStar_Pervasives_Native.None -> - let resugared_args = resugar args1 in - let expect_n = - FStar_Parser_ToDocument.handleable_args_length op1 in - if - (FStar_Compiler_List.length resugared_args) >= - expect_n + let uu___15 = + let uu___16 = + FStar_Errors_Msg.rendermsg + s in + (body3, uu___16, p) in + FStar_Parser_AST.Labeled + uu___15 in + mk uu___14 in + ([], uu___13) + | uu___13 -> + FStar_Compiler_Effect.failwith + "wrong pattern format for QForall/QExists" in + (match uu___12 with + | (pats, body4) -> (pats, body4)) + | uu___12 -> + let uu___13 = resugar_term' env body2 in + ([], uu___13) in + (match uu___10 with + | (pats, body3) -> + let decompile_op op1 = + let uu___11 = + FStar_Parser_AST.string_to_op op1 in + match uu___11 with + | FStar_Pervasives_Native.None -> op1 + | FStar_Pervasives_Native.Some + (op2, uu___12) -> op2 in + let flavor_matches t2 = + match ((t2.FStar_Parser_AST.tm), op) + with + | (FStar_Parser_AST.QExists uu___11, + "exists") -> true + | (FStar_Parser_AST.QForall uu___11, + "forall") -> true + | (FStar_Parser_AST.QuantOp + (id, uu___11, uu___12, uu___13), + uu___14) -> + let uu___15 = + FStar_Ident.string_of_id id in + uu___15 = op + | uu___11 -> false in + let uu___11 = + uncurry xs3 pats body3 flavor_matches in + (match uu___11 with + | (xs4, pats1, body4) -> + let binders = + FStar_Parser_AST.idents_of_binders + xs4 t1.FStar_Syntax_Syntax.pos in + if op = "forall" + then + mk + (FStar_Parser_AST.QForall + (xs4, (binders, pats1), + body4)) + else + if op = "exists" + then + mk + (FStar_Parser_AST.QExists + (xs4, (binders, pats1), + body4)) + else + (let uu___14 = + let uu___15 = + let uu___16 = + FStar_Ident.id_of_text + op in + (uu___16, xs4, + (binders, pats1), + body4) in + FStar_Parser_AST.QuantOp + uu___15 in + mk uu___14)))) + | uu___8 -> + if op = "forall" + then + let uu___9 = + let uu___10 = + let uu___11 = resugar_term' env body in + ([], ([], []), uu___11) in + FStar_Parser_AST.QForall uu___10 in + mk uu___9 + else + (let uu___10 = + let uu___11 = + let uu___12 = resugar_term' env body in + ([], ([], []), uu___12) in + FStar_Parser_AST.QExists uu___11 in + mk uu___10) in + if (FStar_Compiler_List.length args1) > Prims.int_zero then - let uu___4 = - FStar_Compiler_Util.first_N expect_n resugared_args in - (match uu___4 with - | (op_args, rest) -> - let head = - let uu___5 = - let uu___6 = - let uu___7 = - FStar_Compiler_List.map - FStar_Pervasives_Native.fst op_args in - (op1, uu___7) in - FStar_Parser_AST.Op uu___6 in - mk uu___5 in - FStar_Compiler_List.fold_left - (fun head1 -> - fun uu___5 -> - match uu___5 with - | (arg, qual) -> - mk - (FStar_Parser_AST.App - (head1, arg, qual))) head rest) + let args2 = last args1 in + (match args2 with + | (b, uu___7)::[] -> resugar_forall_body b + | uu___7 -> + FStar_Compiler_Effect.failwith + "wrong args format to QForall") else resugar_as_app e args1 - | FStar_Pervasives_Native.Some n when - (FStar_Compiler_List.length args1) = n -> - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = resugar args1 in - FStar_Compiler_List.map - FStar_Pervasives_Native.fst uu___7 in - (op1, uu___6) in - FStar_Parser_AST.Op uu___5 in - mk uu___4 - | uu___4 -> resugar_as_app e args1)) + | FStar_Pervasives_Native.Some ("alloc", uu___6) -> + let uu___7 = FStar_Compiler_List.hd args1 in + (match uu___7 with + | (e1, uu___8) -> resugar_term' env e1) + | FStar_Pervasives_Native.Some (op, expected_arity1) -> + let op1 = FStar_Ident.id_of_text op in + let resugar args2 = + FStar_Compiler_List.map + (fun uu___6 -> + match uu___6 with + | (e1, qual) -> + let uu___7 = resugar_term' env e1 in + let uu___8 = resugar_aqual env qual in + (uu___7, uu___8)) args2 in + (match expected_arity1 with + | FStar_Pervasives_Native.None -> + let resugared_args = resugar args1 in + let expect_n = + FStar_Parser_ToDocument.handleable_args_length + op1 in + if + (FStar_Compiler_List.length resugared_args) >= + expect_n + then + let uu___6 = + FStar_Compiler_Util.first_N expect_n + resugared_args in + (match uu___6 with + | (op_args, rest) -> + let head = + let uu___7 = + let uu___8 = + let uu___9 = + FStar_Compiler_List.map + FStar_Pervasives_Native.fst + op_args in + (op1, uu___9) in + FStar_Parser_AST.Op uu___8 in + mk uu___7 in + FStar_Compiler_List.fold_left + (fun head1 -> + fun uu___7 -> + match uu___7 with + | (arg, qual) -> + mk + (FStar_Parser_AST.App + (head1, arg, qual))) head + rest) + else resugar_as_app e args1 + | FStar_Pervasives_Native.Some n when + (FStar_Compiler_List.length args1) = n -> + let uu___6 = + let uu___7 = + let uu___8 = + let uu___9 = resugar args1 in + FStar_Compiler_List.map + FStar_Pervasives_Native.fst uu___9 in + (op1, uu___8) in + FStar_Parser_AST.Op uu___7 in + mk uu___6 + | uu___6 -> resugar_as_app e args1))) | FStar_Syntax_Syntax.Tm_match { FStar_Syntax_Syntax.scrutinee = e; FStar_Syntax_Syntax.ret_opt = FStar_Pervasives_Native.None; diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml index 2017531fc3e..eb41d6dddac 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml @@ -1302,19 +1302,75 @@ let (global : (FStar_Tactics_NamedView.Tv_FVar fv)) typ k)) uu___3)) st.glb)) uu___1) +exception Next +let (uu___is_Next : Prims.exn -> Prims.bool) = + fun projectee -> match projectee with | Next -> true | uu___ -> false +let (try_trivial : + st_t -> + tc_goal -> + (st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) -> + unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) + = + fun st -> + fun g -> + fun k -> + fun uu___ -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (224)) (Prims.of_int (8)) + (Prims.of_int (224)) (Prims.of_int (11))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (224)) (Prims.of_int (2)) + (Prims.of_int (229)) (Prims.of_int (19))))) + (Obj.magic (FStar_Tactics_NamedView.inspect g.g)) + (fun uu___1 -> + (fun uu___1 -> + match uu___1 with + | FStar_Tactics_NamedView.Tv_FVar fv -> + Obj.magic + (Obj.repr + (if + (FStar_Reflection_V2_Builtins.implode_qn + (FStar_Reflection_V2_Builtins.inspect_fv fv)) + = "Prims.unit" + then + Obj.repr + (FStar_Tactics_V2_Derived.exact + (FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_Const + FStar_Reflection_V2_Data.C_Unit))) + else Obj.repr (FStar_Tactics_Effect.raise Next))) + | uu___2 -> + Obj.magic (Obj.repr (FStar_Tactics_Effect.raise Next))) + uu___1) +let op_Less_Bar_Greater : + 'a . + (unit -> ('a, unit) FStar_Tactics_Effect.tac_repr) -> + (unit -> ('a, unit) FStar_Tactics_Effect.tac_repr) -> + unit -> ('a, unit) FStar_Tactics_Effect.tac_repr + = + fun t1 -> + fun t2 -> + fun uu___ -> + FStar_Tactics_V2_Derived.try_with + (fun uu___1 -> match () with | () -> t1 ()) (fun uu___1 -> t2 ()) let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun st -> FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (228)) (Prims.of_int (4)) (Prims.of_int (229)) + (Prims.of_int (241)) (Prims.of_int (4)) (Prims.of_int (242)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (230)) (Prims.of_int (4)) (Prims.of_int (257)) - (Prims.of_int (60))))) + (Prims.of_int (243)) (Prims.of_int (4)) (Prims.of_int (272)) + (Prims.of_int (33))))) (if st.fuel <= Prims.int_zero then FStar_Tactics_Effect.raise NoInst else FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())) @@ -1325,13 +1381,13 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (230)) (Prims.of_int (4)) - (Prims.of_int (230)) (Prims.of_int (55))))) + (Prims.of_int (243)) (Prims.of_int (4)) + (Prims.of_int (243)) (Prims.of_int (55))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (232)) (Prims.of_int (4)) - (Prims.of_int (257)) (Prims.of_int (60))))) + (Prims.of_int (245)) (Prims.of_int (4)) + (Prims.of_int (272)) (Prims.of_int (33))))) (Obj.magic (debug (fun uu___1 -> @@ -1350,14 +1406,14 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (232)) (Prims.of_int (4)) - (Prims.of_int (232)) (Prims.of_int (18))))) + (Prims.of_int (245)) (Prims.of_int (4)) + (Prims.of_int (245)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (232)) (Prims.of_int (19)) - (Prims.of_int (257)) (Prims.of_int (60))))) + (Prims.of_int (245)) (Prims.of_int (19)) + (Prims.of_int (272)) (Prims.of_int (33))))) (Obj.magic (maybe_intros ())) (fun uu___2 -> (fun uu___2 -> @@ -1367,18 +1423,18 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (233)) + (Prims.of_int (246)) (Prims.of_int (12)) - (Prims.of_int (233)) + (Prims.of_int (246)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (236)) + (Prims.of_int (249)) (Prims.of_int (4)) - (Prims.of_int (257)) - (Prims.of_int (60))))) + (Prims.of_int (272)) + (Prims.of_int (33))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_goal ())) @@ -1390,18 +1446,18 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (236)) + (Prims.of_int (249)) (Prims.of_int (4)) - (Prims.of_int (239)) + (Prims.of_int (252)) (Prims.of_int (5))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (241)) + (Prims.of_int (254)) (Prims.of_int (4)) - (Prims.of_int (257)) - (Prims.of_int (60))))) + (Prims.of_int (272)) + (Prims.of_int (33))))) (if FStar_List_Tot_Base.existsb (FStar_Reflection_V2_TermEq.term_eq @@ -1414,17 +1470,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (237)) + (Prims.of_int (250)) (Prims.of_int (6)) - (Prims.of_int (237)) + (Prims.of_int (250)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (238)) + (Prims.of_int (251)) (Prims.of_int (6)) - (Prims.of_int (238)) + (Prims.of_int (251)) (Prims.of_int (18))))) (Obj.magic (debug @@ -1455,18 +1511,18 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (241)) + (Prims.of_int (254)) (Prims.of_int (10)) - (Prims.of_int (241)) + (Prims.of_int (254)) (Prims.of_int (15))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (241)) + (Prims.of_int (254)) (Prims.of_int (4)) - (Prims.of_int (257)) - (Prims.of_int (60))))) + (Prims.of_int (272)) + (Prims.of_int (33))))) (Obj.magic (hua g)) (fun uu___4 -> @@ -1483,17 +1539,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (243)) + (Prims.of_int (256)) (Prims.of_int (6)) - (Prims.of_int (243)) + (Prims.of_int (256)) (Prims.of_int (61))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (244)) + (Prims.of_int (257)) (Prims.of_int (6)) - (Prims.of_int (244)) + (Prims.of_int (257)) (Prims.of_int (18))))) (Obj.magic (debug @@ -1522,35 +1578,35 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (248)) + (Prims.of_int (261)) (Prims.of_int (17)) - (Prims.of_int (248)) + (Prims.of_int (261)) (Prims.of_int (61))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (248)) + (Prims.of_int (261)) (Prims.of_int (64)) - (Prims.of_int (257)) - (Prims.of_int (60))))) + (Prims.of_int (272)) + (Prims.of_int (33))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (248)) + (Prims.of_int (261)) (Prims.of_int (28)) - (Prims.of_int (248)) + (Prims.of_int (261)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (248)) + (Prims.of_int (261)) (Prims.of_int (17)) - (Prims.of_int (248)) + (Prims.of_int (261)) (Prims.of_int (61))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_env @@ -1574,18 +1630,18 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (249)) + (Prims.of_int (262)) (Prims.of_int (20)) - (Prims.of_int (251)) + (Prims.of_int (264)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (252)) + (Prims.of_int (265)) (Prims.of_int (8)) - (Prims.of_int (257)) - (Prims.of_int (60))))) + (Prims.of_int (272)) + (Prims.of_int (33))))) (match c_se with | @@ -1615,18 +1671,18 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (254)) + (Prims.of_int (267)) (Prims.of_int (27)) - (Prims.of_int (254)) + (Prims.of_int (267)) (Prims.of_int (89))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (254)) + (Prims.of_int (267)) (Prims.of_int (92)) - (Prims.of_int (257)) - (Prims.of_int (60))))) + (Prims.of_int (272)) + (Prims.of_int (33))))) (Obj.magic (FStar_Tactics_Util.map (fun @@ -1640,17 +1696,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (254)) + (Prims.of_int (267)) (Prims.of_int (67)) - (Prims.of_int (254)) + (Prims.of_int (267)) (Prims.of_int (88))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (254)) + (Prims.of_int (267)) (Prims.of_int (59)) - (Prims.of_int (254)) + (Prims.of_int (267)) (Prims.of_int (88))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1658,17 +1714,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (254)) + (Prims.of_int (267)) (Prims.of_int (73)) - (Prims.of_int (254)) + (Prims.of_int (267)) (Prims.of_int (88))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (254)) + (Prims.of_int (267)) (Prims.of_int (67)) - (Prims.of_int (254)) + (Prims.of_int (267)) (Prims.of_int (88))))) (Obj.magic (FStar_Tactics_V2_Builtins.free_uvars @@ -1699,18 +1755,18 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (255)) + (Prims.of_int (268)) (Prims.of_int (17)) - (Prims.of_int (255)) + (Prims.of_int (268)) (Prims.of_int (44))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (255)) + (Prims.of_int (268)) (Prims.of_int (49)) - (Prims.of_int (257)) - (Prims.of_int (60))))) + (Prims.of_int (272)) + (Prims.of_int (33))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___5 -> @@ -1733,18 +1789,18 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (256)) + (Prims.of_int (269)) (Prims.of_int (16)) - (Prims.of_int (256)) + (Prims.of_int (269)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (257)) + (Prims.of_int (270)) (Prims.of_int (6)) - (Prims.of_int (257)) - (Prims.of_int (60))))) + (Prims.of_int (272)) + (Prims.of_int (33))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___5 -> @@ -1760,13 +1816,18 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (fun g1 -> Obj.magic - (FStar_Tactics_V2_Derived.or_else - (local + (op_Less_Bar_Greater + (op_Less_Bar_Greater + (try_trivial st1 g1 tcresolve') + (local + st1 g1 + tcresolve')) (global st1 g1 - tcresolve'))) + tcresolve') + ())) uu___5))) uu___5))) uu___5))) @@ -1797,14 +1858,14 @@ let rec concatMap : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (262)) (Prims.of_int (13)) - (Prims.of_int (262)) (Prims.of_int (16))))) + (Prims.of_int (277)) (Prims.of_int (13)) + (Prims.of_int (277)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (262)) (Prims.of_int (13)) - (Prims.of_int (262)) (Prims.of_int (33))))) + (Prims.of_int (277)) (Prims.of_int (13)) + (Prims.of_int (277)) (Prims.of_int (33))))) (Obj.magic (f x)) (fun uu___ -> (fun uu___ -> @@ -1814,17 +1875,17 @@ let rec concatMap : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (262)) + (Prims.of_int (277)) (Prims.of_int (19)) - (Prims.of_int (262)) + (Prims.of_int (277)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (262)) + (Prims.of_int (277)) (Prims.of_int (13)) - (Prims.of_int (262)) + (Prims.of_int (277)) (Prims.of_int (33))))) (Obj.magic (concatMap f xs)) (fun uu___1 -> @@ -1837,12 +1898,12 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (267)) (Prims.of_int (4)) (Prims.of_int (267)) + (Prims.of_int (282)) (Prims.of_int (4)) (Prims.of_int (282)) (Prims.of_int (54))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (267)) (Prims.of_int (55)) (Prims.of_int (300)) + (Prims.of_int (282)) (Prims.of_int (55)) (Prims.of_int (315)) (Prims.of_int (18))))) (Obj.magic (debug @@ -1851,13 +1912,13 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (267)) (Prims.of_int (21)) - (Prims.of_int (267)) (Prims.of_int (28))))) + (Prims.of_int (282)) (Prims.of_int (21)) + (Prims.of_int (282)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (267)) (Prims.of_int (30)) - (Prims.of_int (267)) (Prims.of_int (53))))) + (Prims.of_int (282)) (Prims.of_int (30)) + (Prims.of_int (282)) (Prims.of_int (53))))) (Obj.magic (FStar_Tactics_V2_Builtins.dump "")) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -1869,13 +1930,13 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (268)) (Prims.of_int (12)) - (Prims.of_int (268)) (Prims.of_int (26))))) + (Prims.of_int (283)) (Prims.of_int (12)) + (Prims.of_int (283)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (269)) (Prims.of_int (4)) - (Prims.of_int (300)) (Prims.of_int (18))))) + (Prims.of_int (284)) (Prims.of_int (4)) + (Prims.of_int (315)) (Prims.of_int (18))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_witness ())) (fun uu___2 -> (fun w -> @@ -1885,14 +1946,14 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (269)) (Prims.of_int (4)) - (Prims.of_int (269)) (Prims.of_int (29))))) + (Prims.of_int (284)) (Prims.of_int (4)) + (Prims.of_int (284)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (272)) (Prims.of_int (4)) - (Prims.of_int (300)) (Prims.of_int (18))))) + (Prims.of_int (287)) (Prims.of_int (4)) + (Prims.of_int (315)) (Prims.of_int (18))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_dump_on_failure false)) @@ -1904,17 +1965,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (272)) + (Prims.of_int (287)) (Prims.of_int (4)) - (Prims.of_int (272)) + (Prims.of_int (287)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (272)) + (Prims.of_int (287)) (Prims.of_int (20)) - (Prims.of_int (300)) + (Prims.of_int (315)) (Prims.of_int (18))))) (Obj.magic (maybe_intros ())) (fun uu___3 -> @@ -1925,17 +1986,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (277)) + (Prims.of_int (292)) (Prims.of_int (14)) - (Prims.of_int (277)) + (Prims.of_int (292)) (Prims.of_int (56))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (277)) + (Prims.of_int (292)) (Prims.of_int (59)) - (Prims.of_int (300)) + (Prims.of_int (315)) (Prims.of_int (18))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1943,17 +2004,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (277)) + (Prims.of_int (292)) (Prims.of_int (44)) - (Prims.of_int (277)) + (Prims.of_int (292)) (Prims.of_int (56))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (277)) + (Prims.of_int (292)) (Prims.of_int (14)) - (Prims.of_int (277)) + (Prims.of_int (292)) (Prims.of_int (56))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_env @@ -1978,17 +2039,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (278)) + (Prims.of_int (293)) (Prims.of_int (14)) - (Prims.of_int (280)) + (Prims.of_int (295)) (Prims.of_int (5))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (281)) + (Prims.of_int (296)) (Prims.of_int (6)) - (Prims.of_int (300)) + (Prims.of_int (315)) (Prims.of_int (18))))) (Obj.magic (concatMap @@ -2015,17 +2076,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (283)) + (Prims.of_int (298)) (Prims.of_int (6)) - (Prims.of_int (285)) + (Prims.of_int (300)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (287)) + (Prims.of_int (302)) (Prims.of_int (4)) - (Prims.of_int (300)) + (Prims.of_int (315)) (Prims.of_int (18))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2054,17 +2115,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (288)) + (Prims.of_int (303)) (Prims.of_int (6)) - (Prims.of_int (288)) + (Prims.of_int (303)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (289)) + (Prims.of_int (304)) (Prims.of_int (6)) - (Prims.of_int (289)) + (Prims.of_int (304)) (Prims.of_int (59))))) (Obj.magic (tcresolve' @@ -2082,9 +2143,9 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (289)) + (Prims.of_int (304)) (Prims.of_int (42)) - (Prims.of_int (289)) + (Prims.of_int (304)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic @@ -2121,17 +2182,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (293)) + (Prims.of_int (308)) (Prims.of_int (15)) - (Prims.of_int (297)) + (Prims.of_int (312)) (Prims.of_int (7))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (293)) + (Prims.of_int (308)) (Prims.of_int (6)) - (Prims.of_int (297)) + (Prims.of_int (312)) (Prims.of_int (7))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2139,17 +2200,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (293)) + (Prims.of_int (308)) (Prims.of_int (15)) - (Prims.of_int (297)) + (Prims.of_int (312)) (Prims.of_int (7))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (293)) + (Prims.of_int (308)) (Prims.of_int (15)) - (Prims.of_int (297)) + (Prims.of_int (312)) (Prims.of_int (7))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2157,17 +2218,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (295)) + (Prims.of_int (310)) (Prims.of_int (8)) - (Prims.of_int (296)) - (Prims.of_int (59))))) + (Prims.of_int (311)) + (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (293)) + (Prims.of_int (308)) (Prims.of_int (15)) - (Prims.of_int (297)) + (Prims.of_int (312)) (Prims.of_int (7))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2175,54 +2236,36 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (296)) + (Prims.of_int (311)) (Prims.of_int (10)) - (Prims.of_int (296)) - (Prims.of_int (59))))) + (Prims.of_int (311)) + (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (295)) + (Prims.of_int (310)) (Prims.of_int (8)) - (Prims.of_int (296)) - (Prims.of_int (59))))) + (Prims.of_int (311)) + (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (296)) - (Prims.of_int (28)) - (Prims.of_int (296)) - (Prims.of_int (58))))) + (Prims.of_int (311)) + (Prims.of_int (23)) + (Prims.of_int (311)) + (Prims.of_int (36))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (296)) + (Prims.of_int (311)) (Prims.of_int (10)) - (Prims.of_int (296)) - (Prims.of_int (59))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (296)) - (Prims.of_int (44)) - (Prims.of_int (296)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (296)) - (Prims.of_int (28)) - (Prims.of_int (296)) - (Prims.of_int (58))))) + (Prims.of_int (311)) + (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_goal ())) @@ -2231,7 +2274,7 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (fun uu___5 -> Obj.magic - (FStar_Tactics_V2_Builtins.term_to_string + (FStar_Tactics_V2_Builtins.term_to_doc uu___5)) uu___5))) (fun @@ -2239,13 +2282,6 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = FStar_Tactics_Effect.lift_div_tac (fun uu___6 -> - FStar_Pprint.arbitrary_string - uu___5)))) - (fun - uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___6 -> FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one @@ -2264,7 +2300,7 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (fun uu___6 -> (FStar_Pprint.arbitrary_string - "Typeclass resolution failed") + "Typeclass resolution failed.") :: uu___5)))) (fun uu___5 -> @@ -2280,7 +2316,7 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = ()) [ FStar_Pprint.arbitrary_string - "Typeclass resolution failed"] + "Typeclass resolution failed."] msg))) | e -> @@ -2327,8 +2363,8 @@ let rec (mk_abs : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (309)) (Prims.of_int (20)) - (Prims.of_int (309)) (Prims.of_int (47))))) + (Prims.of_int (324)) (Prims.of_int (20)) + (Prims.of_int (324)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "dummy" Prims.int_zero @@ -2339,17 +2375,17 @@ let rec (mk_abs : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (309)) + (Prims.of_int (324)) (Prims.of_int (30)) - (Prims.of_int (309)) + (Prims.of_int (324)) (Prims.of_int (46))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (309)) + (Prims.of_int (324)) (Prims.of_int (20)) - (Prims.of_int (309)) + (Prims.of_int (324)) (Prims.of_int (47))))) (Obj.magic (mk_abs bs1 body)) (fun uu___ -> @@ -2408,12 +2444,12 @@ let (mk_class : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (333)) (Prims.of_int (13)) (Prims.of_int (333)) + (Prims.of_int (348)) (Prims.of_int (13)) (Prims.of_int (348)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (333)) (Prims.of_int (29)) (Prims.of_int (423)) + (Prims.of_int (348)) (Prims.of_int (29)) (Prims.of_int (438)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Reflection_V2_Builtins.explode_qn nm)) @@ -2424,27 +2460,27 @@ let (mk_class : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (334)) (Prims.of_int (12)) - (Prims.of_int (334)) (Prims.of_int (38))))) + (Prims.of_int (349)) (Prims.of_int (12)) + (Prims.of_int (349)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (335)) (Prims.of_int (4)) - (Prims.of_int (423)) (Prims.of_int (5))))) + (Prims.of_int (350)) (Prims.of_int (4)) + (Prims.of_int (438)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (334)) (Prims.of_int (23)) - (Prims.of_int (334)) (Prims.of_int (35))))) + (Prims.of_int (349)) (Prims.of_int (23)) + (Prims.of_int (349)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (334)) (Prims.of_int (12)) - (Prims.of_int (334)) (Prims.of_int (38))))) + (Prims.of_int (349)) (Prims.of_int (12)) + (Prims.of_int (349)) (Prims.of_int (38))))) (Obj.magic (FStar_Tactics_V2_Builtins.top_env ())) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac @@ -2459,14 +2495,14 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (335)) (Prims.of_int (4)) - (Prims.of_int (335)) (Prims.of_int (19))))) + (Prims.of_int (350)) (Prims.of_int (4)) + (Prims.of_int (350)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (335)) (Prims.of_int (20)) - (Prims.of_int (423)) (Prims.of_int (5))))) + (Prims.of_int (350)) (Prims.of_int (20)) + (Prims.of_int (438)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard (FStar_Pervasives_Native.uu___is_Some r))) @@ -2478,17 +2514,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (336)) + (Prims.of_int (351)) (Prims.of_int (18)) - (Prims.of_int (336)) + (Prims.of_int (351)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (335)) + (Prims.of_int (350)) (Prims.of_int (20)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> r)) @@ -2503,17 +2539,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (337)) + (Prims.of_int (352)) (Prims.of_int (23)) - (Prims.of_int (337)) + (Prims.of_int (352)) (Prims.of_int (115))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (337)) + (Prims.of_int (352)) (Prims.of_int (118)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> @@ -2538,18 +2574,18 @@ let (mk_class : Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (338)) + (Prims.of_int (353)) (Prims.of_int (13)) - (Prims.of_int (338)) + (Prims.of_int (353)) (Prims.of_int (30))))) (FStar_Sealed.seal ( Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (339)) + (Prims.of_int (354)) (Prims.of_int (4)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (Obj.magic ( @@ -2565,17 +2601,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (339)) + (Prims.of_int (354)) (Prims.of_int (4)) - (Prims.of_int (339)) + (Prims.of_int (354)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (339)) + (Prims.of_int (354)) (Prims.of_int (29)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard @@ -2591,17 +2627,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (340)) + (Prims.of_int (355)) (Prims.of_int (63)) - (Prims.of_int (340)) + (Prims.of_int (355)) (Prims.of_int (65))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (339)) + (Prims.of_int (354)) (Prims.of_int (29)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2633,17 +2669,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (341)) + (Prims.of_int (356)) (Prims.of_int (4)) - (Prims.of_int (341)) + (Prims.of_int (356)) (Prims.of_int (87))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (342)) + (Prims.of_int (357)) (Prims.of_int (4)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2654,9 +2690,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (341)) + (Prims.of_int (356)) (Prims.of_int (35)) - (Prims.of_int (341)) + (Prims.of_int (356)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -2688,17 +2724,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (342)) + (Prims.of_int (357)) (Prims.of_int (4)) - (Prims.of_int (342)) + (Prims.of_int (357)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (343)) + (Prims.of_int (358)) (Prims.of_int (4)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2725,17 +2761,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (343)) + (Prims.of_int (358)) (Prims.of_int (4)) - (Prims.of_int (343)) + (Prims.of_int (358)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (343)) + (Prims.of_int (358)) (Prims.of_int (60)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2746,9 +2782,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (343)) + (Prims.of_int (358)) (Prims.of_int (40)) - (Prims.of_int (343)) + (Prims.of_int (358)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic @@ -2779,17 +2815,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (344)) + (Prims.of_int (359)) (Prims.of_int (20)) - (Prims.of_int (344)) + (Prims.of_int (359)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (346)) + (Prims.of_int (361)) (Prims.of_int (4)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (Obj.magic (last @@ -2805,17 +2841,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (346)) + (Prims.of_int (361)) (Prims.of_int (4)) - (Prims.of_int (346)) + (Prims.of_int (361)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (346)) + (Prims.of_int (361)) (Prims.of_int (31)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard @@ -2832,17 +2868,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (347)) + (Prims.of_int (362)) (Prims.of_int (25)) - (Prims.of_int (347)) + (Prims.of_int (362)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (346)) + (Prims.of_int (361)) (Prims.of_int (31)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2864,17 +2900,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (348)) + (Prims.of_int (363)) (Prims.of_int (4)) - (Prims.of_int (348)) + (Prims.of_int (363)) (Prims.of_int (87))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (348)) + (Prims.of_int (363)) (Prims.of_int (88)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2885,9 +2921,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (348)) + (Prims.of_int (363)) (Prims.of_int (35)) - (Prims.of_int (348)) + (Prims.of_int (363)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -2903,9 +2939,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (348)) + (Prims.of_int (363)) (Prims.of_int (55)) - (Prims.of_int (348)) + (Prims.of_int (363)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -2921,9 +2957,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (348)) + (Prims.of_int (363)) (Prims.of_int (69)) - (Prims.of_int (348)) + (Prims.of_int (363)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -2977,17 +3013,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (349)) + (Prims.of_int (364)) (Prims.of_int (18)) - (Prims.of_int (349)) + (Prims.of_int (364)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (348)) + (Prims.of_int (363)) (Prims.of_int (88)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_arr_bs @@ -3009,17 +3045,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (350)) + (Prims.of_int (365)) (Prims.of_int (12)) - (Prims.of_int (350)) + (Prims.of_int (365)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (351)) + (Prims.of_int (366)) (Prims.of_int (4)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3038,17 +3074,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (351)) + (Prims.of_int (366)) (Prims.of_int (4)) - (Prims.of_int (351)) + (Prims.of_int (366)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (351)) + (Prims.of_int (366)) (Prims.of_int (23)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard @@ -3066,17 +3102,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (352)) + (Prims.of_int (367)) (Prims.of_int (22)) - (Prims.of_int (352)) + (Prims.of_int (367)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (351)) + (Prims.of_int (366)) (Prims.of_int (23)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3099,17 +3135,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (354)) + (Prims.of_int (369)) (Prims.of_int (4)) - (Prims.of_int (354)) + (Prims.of_int (369)) (Prims.of_int (87))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (355)) + (Prims.of_int (370)) (Prims.of_int (4)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (Obj.magic (debug @@ -3121,9 +3157,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (354)) + (Prims.of_int (369)) (Prims.of_int (35)) - (Prims.of_int (354)) + (Prims.of_int (369)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -3159,17 +3195,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (355)) + (Prims.of_int (370)) (Prims.of_int (4)) - (Prims.of_int (355)) + (Prims.of_int (370)) (Prims.of_int (81))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (356)) + (Prims.of_int (371)) (Prims.of_int (4)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (Obj.magic (debug @@ -3202,17 +3238,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (356)) + (Prims.of_int (371)) (Prims.of_int (4)) - (Prims.of_int (356)) + (Prims.of_int (371)) (Prims.of_int (76))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (357)) + (Prims.of_int (372)) (Prims.of_int (4)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (Obj.magic (debug @@ -3245,17 +3281,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (357)) + (Prims.of_int (372)) (Prims.of_int (4)) - (Prims.of_int (357)) + (Prims.of_int (372)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (357)) + (Prims.of_int (372)) (Prims.of_int (52)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (Obj.magic (debug @@ -3267,9 +3303,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (357)) + (Prims.of_int (372)) (Prims.of_int (32)) - (Prims.of_int (357)) + (Prims.of_int (372)) (Prims.of_int (50))))) (FStar_Sealed.seal (Obj.magic @@ -3304,17 +3340,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (361)) + (Prims.of_int (376)) (Prims.of_int (24)) - (Prims.of_int (361)) + (Prims.of_int (376)) (Prims.of_int (61))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (364)) + (Prims.of_int (379)) (Prims.of_int (4)) - (Prims.of_int (423)) + (Prims.of_int (438)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3338,17 +3374,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (366)) + (Prims.of_int (381)) (Prims.of_int (14)) - (Prims.of_int (366)) + (Prims.of_int (381)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (367)) + (Prims.of_int (382)) (Prims.of_int (6)) - (Prims.of_int (422)) + (Prims.of_int (437)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_V2_Derived.name_of_binder @@ -3363,17 +3399,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (367)) + (Prims.of_int (382)) (Prims.of_int (6)) - (Prims.of_int (367)) + (Prims.of_int (382)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (367)) + (Prims.of_int (382)) (Prims.of_int (49)) - (Prims.of_int (422)) + (Prims.of_int (437)) (Prims.of_int (8))))) (Obj.magic (debug @@ -3404,17 +3440,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (368)) + (Prims.of_int (383)) (Prims.of_int (15)) - (Prims.of_int (368)) + (Prims.of_int (383)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (368)) + (Prims.of_int (383)) (Prims.of_int (31)) - (Prims.of_int (422)) + (Prims.of_int (437)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_module @@ -3430,17 +3466,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (369)) + (Prims.of_int (384)) (Prims.of_int (16)) - (Prims.of_int (369)) + (Prims.of_int (384)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (369)) + (Prims.of_int (384)) (Prims.of_int (37)) - (Prims.of_int (422)) + (Prims.of_int (437)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3461,17 +3497,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (370)) + (Prims.of_int (385)) (Prims.of_int (16)) - (Prims.of_int (370)) + (Prims.of_int (385)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (370)) + (Prims.of_int (385)) (Prims.of_int (41)) - (Prims.of_int (422)) + (Prims.of_int (437)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_V2_Derived.fresh_namedv_named @@ -3487,17 +3523,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (371)) + (Prims.of_int (386)) (Prims.of_int (16)) - (Prims.of_int (371)) + (Prims.of_int (386)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (371)) + (Prims.of_int (386)) (Prims.of_int (31)) - (Prims.of_int (422)) + (Prims.of_int (437)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3521,17 +3557,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (373)) + (Prims.of_int (388)) (Prims.of_int (8)) - (Prims.of_int (377)) + (Prims.of_int (392)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (378)) + (Prims.of_int (393)) (Prims.of_int (10)) - (Prims.of_int (422)) + (Prims.of_int (437)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3539,17 +3575,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (375)) + (Prims.of_int (390)) (Prims.of_int (17)) - (Prims.of_int (375)) + (Prims.of_int (390)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (373)) + (Prims.of_int (388)) (Prims.of_int (8)) - (Prims.of_int (377)) + (Prims.of_int (392)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V2_Builtins.fresh @@ -3588,17 +3624,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (379)) + (Prims.of_int (394)) (Prims.of_int (22)) - (Prims.of_int (379)) + (Prims.of_int (394)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (379)) + (Prims.of_int (394)) (Prims.of_int (51)) - (Prims.of_int (422)) + (Prims.of_int (437)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3606,17 +3642,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (379)) + (Prims.of_int (394)) (Prims.of_int (22)) - (Prims.of_int (379)) + (Prims.of_int (394)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (379)) + (Prims.of_int (394)) (Prims.of_int (22)) - (Prims.of_int (379)) + (Prims.of_int (394)) (Prims.of_int (48))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_module @@ -3645,17 +3681,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (380)) + (Prims.of_int (395)) (Prims.of_int (17)) - (Prims.of_int (380)) + (Prims.of_int (395)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (380)) + (Prims.of_int (395)) (Prims.of_int (54)) - (Prims.of_int (422)) + (Prims.of_int (437)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3676,17 +3712,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (383)) + (Prims.of_int (398)) (Prims.of_int (8)) - (Prims.of_int (388)) + (Prims.of_int (403)) (Prims.of_int (50))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (389)) + (Prims.of_int (404)) (Prims.of_int (8)) - (Prims.of_int (422)) + (Prims.of_int (437)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3694,17 +3730,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (383)) + (Prims.of_int (398)) (Prims.of_int (14)) - (Prims.of_int (383)) + (Prims.of_int (398)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (383)) + (Prims.of_int (398)) (Prims.of_int (8)) - (Prims.of_int (388)) + (Prims.of_int (403)) (Prims.of_int (50))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3712,17 +3748,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (383)) + (Prims.of_int (398)) (Prims.of_int (25)) - (Prims.of_int (383)) + (Prims.of_int (398)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (383)) + (Prims.of_int (398)) (Prims.of_int (14)) - (Prims.of_int (383)) + (Prims.of_int (398)) (Prims.of_int (47))))) (Obj.magic (FStar_Tactics_V2_Builtins.top_env @@ -3762,17 +3798,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (386)) + (Prims.of_int (401)) (Prims.of_int (16)) - (Prims.of_int (386)) + (Prims.of_int (401)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (386)) + (Prims.of_int (401)) (Prims.of_int (10)) - (Prims.of_int (388)) + (Prims.of_int (403)) (Prims.of_int (50))))) (Obj.magic (FStar_Tactics_NamedView.inspect_sigelt @@ -3819,17 +3855,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (392)) + (Prims.of_int (407)) (Prims.of_int (14)) - (Prims.of_int (399)) + (Prims.of_int (414)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (400)) + (Prims.of_int (415)) (Prims.of_int (8)) - (Prims.of_int (422)) + (Prims.of_int (437)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3837,17 +3873,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (393)) + (Prims.of_int (408)) (Prims.of_int (22)) - (Prims.of_int (393)) + (Prims.of_int (408)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (392)) + (Prims.of_int (407)) (Prims.of_int (14)) - (Prims.of_int (399)) + (Prims.of_int (414)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_arr_bs @@ -3869,17 +3905,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (394)) + (Prims.of_int (409)) (Prims.of_int (21)) - (Prims.of_int (394)) + (Prims.of_int (409)) (Prims.of_int (75))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (393)) + (Prims.of_int (408)) (Prims.of_int (54)) - (Prims.of_int (399)) + (Prims.of_int (414)) (Prims.of_int (37))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3918,17 +3954,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (398)) + (Prims.of_int (413)) (Prims.of_int (21)) - (Prims.of_int (398)) + (Prims.of_int (413)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (399)) + (Prims.of_int (414)) (Prims.of_int (12)) - (Prims.of_int (399)) + (Prims.of_int (414)) (Prims.of_int (37))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3962,17 +3998,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (401)) + (Prims.of_int (416)) (Prims.of_int (15)) - (Prims.of_int (408)) + (Prims.of_int (423)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (410)) + (Prims.of_int (425)) (Prims.of_int (6)) - (Prims.of_int (422)) + (Prims.of_int (437)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3980,17 +4016,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (402)) + (Prims.of_int (417)) (Prims.of_int (23)) - (Prims.of_int (402)) + (Prims.of_int (417)) (Prims.of_int (49))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (401)) + (Prims.of_int (416)) (Prims.of_int (15)) - (Prims.of_int (408)) + (Prims.of_int (423)) (Prims.of_int (38))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_abs @@ -4012,17 +4048,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (403)) + (Prims.of_int (418)) (Prims.of_int (21)) - (Prims.of_int (403)) + (Prims.of_int (418)) (Prims.of_int (75))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (402)) + (Prims.of_int (417)) (Prims.of_int (52)) - (Prims.of_int (408)) + (Prims.of_int (423)) (Prims.of_int (38))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -4061,17 +4097,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (407)) + (Prims.of_int (422)) (Prims.of_int (21)) - (Prims.of_int (407)) + (Prims.of_int (422)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (408)) + (Prims.of_int (423)) (Prims.of_int (12)) - (Prims.of_int (408)) + (Prims.of_int (423)) (Prims.of_int (38))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -4105,17 +4141,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (410)) + (Prims.of_int (425)) (Prims.of_int (6)) - (Prims.of_int (410)) + (Prims.of_int (425)) (Prims.of_int (53))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (411)) + (Prims.of_int (426)) (Prims.of_int (6)) - (Prims.of_int (422)) + (Prims.of_int (437)) (Prims.of_int (8))))) (Obj.magic (debug @@ -4127,9 +4163,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (410)) + (Prims.of_int (425)) (Prims.of_int (34)) - (Prims.of_int (410)) + (Prims.of_int (425)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic @@ -4164,17 +4200,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (411)) + (Prims.of_int (426)) (Prims.of_int (6)) - (Prims.of_int (411)) + (Prims.of_int (426)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (411)) + (Prims.of_int (426)) (Prims.of_int (53)) - (Prims.of_int (422)) + (Prims.of_int (437)) (Prims.of_int (8))))) (Obj.magic (debug @@ -4186,9 +4222,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (411)) + (Prims.of_int (426)) (Prims.of_int (34)) - (Prims.of_int (411)) + (Prims.of_int (426)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic @@ -4223,17 +4259,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (413)) + (Prims.of_int (428)) (Prims.of_int (22)) - (Prims.of_int (413)) + (Prims.of_int (428)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (413)) + (Prims.of_int (428)) (Prims.of_int (27)) - (Prims.of_int (422)) + (Prims.of_int (437)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -4250,17 +4286,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (414)) + (Prims.of_int (429)) (Prims.of_int (23)) - (Prims.of_int (414)) + (Prims.of_int (429)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (414)) + (Prims.of_int (429)) (Prims.of_int (29)) - (Prims.of_int (422)) + (Prims.of_int (437)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -4277,17 +4313,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (415)) + (Prims.of_int (430)) (Prims.of_int (21)) - (Prims.of_int (415)) + (Prims.of_int (430)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (415)) + (Prims.of_int (430)) (Prims.of_int (27)) - (Prims.of_int (422)) + (Prims.of_int (437)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -4304,17 +4340,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (417)) + (Prims.of_int (432)) (Prims.of_int (17)) - (Prims.of_int (417)) + (Prims.of_int (432)) (Prims.of_int (70))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (417)) + (Prims.of_int (432)) (Prims.of_int (75)) - (Prims.of_int (422)) + (Prims.of_int (437)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -4342,17 +4378,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (418)) + (Prims.of_int (433)) (Prims.of_int (15)) - (Prims.of_int (418)) + (Prims.of_int (433)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (420)) + (Prims.of_int (435)) (Prims.of_int (15)) - (Prims.of_int (420)) + (Prims.of_int (435)) (Prims.of_int (42))))) (Obj.magic (FStar_Tactics_NamedView.pack_sigelt diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml index dc6b1f1c378..f3f28e4bb3e 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml @@ -77,7 +77,7 @@ let (core_check : let uu___5 = let uu___6 = FStar_TypeChecker_Env.get_range env in FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range uu___6 in + FStar_Compiler_Range_Ops.showable_range uu___6 in let uu___6 = FStar_TypeChecker_Core.print_error_short err in let uu___7 = @@ -1096,7 +1096,7 @@ let (__do_unify_wflags : msg in let uu___10 = FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range + FStar_Compiler_Range_Ops.showable_range r in FStar_Compiler_Util.print2 ">> do_unify error, (%s) at (%s)\n" @@ -9237,7 +9237,8 @@ let (comp_to_string : let (range_to_string : FStar_Compiler_Range_Type.range -> Prims.string FStar_Tactics_Monad.tac) = fun r -> - let uu___ = FStar_Class_Show.show FStar_Compiler_Range_Ops.show_range r in + let uu___ = + FStar_Class_Show.show FStar_Compiler_Range_Ops.showable_range r in ret uu___ let (term_eq_old : FStar_Syntax_Syntax.term -> diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml index 5c755c0378d..cf039004dd6 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml @@ -63,7 +63,7 @@ let (core_check : let uu___5 = let uu___6 = FStar_TypeChecker_Env.get_range env in FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range uu___6 in + FStar_Compiler_Range_Ops.showable_range uu___6 in let uu___6 = FStar_TypeChecker_Core.print_error_short err in let uu___7 = @@ -1187,7 +1187,7 @@ let (__do_unify_wflags : msg in let uu___9 = FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range + FStar_Compiler_Range_Ops.showable_range r in FStar_Compiler_Util.print2 ">> do_unify error, (%s) at (%s)\n" @@ -9557,7 +9557,7 @@ let (range_to_string : fun uu___ -> (fun r -> let uu___ = - FStar_Class_Show.show FStar_Compiler_Range_Ops.show_range r in + FStar_Class_Show.show FStar_Compiler_Range_Ops.showable_range r in Obj.magic (FStar_Class_Monad.return FStar_Tactics_Monad.monad_tac () (Obj.magic uu___))) uu___ @@ -10543,7 +10543,7 @@ let (refl_tc_term : (fun uu___3 -> let uu___4 = FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range + FStar_Compiler_Range_Ops.showable_range e.FStar_Syntax_Syntax.pos in let uu___5 = FStar_Class_Show.show @@ -10824,7 +10824,7 @@ let (refl_tc_term : FStar_TypeChecker_Env.get_range g3 in FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range + FStar_Compiler_Range_Ops.showable_range uu___11 in let uu___11 = FStar_Class_Show.show @@ -10832,7 +10832,7 @@ let (refl_tc_term : guard in let uu___12 = FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range + FStar_Compiler_Range_Ops.showable_range guard.FStar_Syntax_Syntax.pos in FStar_Compiler_Util.format3 "Got guard in Env@%s |- %s@%s\n" @@ -10855,7 +10855,7 @@ let (refl_tc_term : (fun uu___10 -> let uu___11 = FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range + FStar_Compiler_Range_Ops.showable_range e2.FStar_Syntax_Syntax.pos in let uu___12 = FStar_Class_Show.show diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Generalize.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Generalize.ml index 396e6494eab..784acaef778 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Generalize.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Generalize.ml @@ -633,7 +633,7 @@ let (generalize' : | (l, us, e, c, gvs) -> let uu___6 = FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range + FStar_Compiler_Range_Ops.showable_range e.FStar_Syntax_Syntax.pos in let uu___7 = FStar_Syntax_Print.lbname_to_string l in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize_Unfolding.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize_Unfolding.ml index b18144f3b1b..897e84643e9 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize_Unfolding.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize_Unfolding.ml @@ -710,8 +710,8 @@ let (should_unfold : FStar_Class_Show.show FStar_Syntax_Print.showable_fv fv in let uu___3 = let uu___4 = FStar_Syntax_Syntax.range_of_fv fv in - FStar_Class_Show.show FStar_Compiler_Range_Ops.show_range - uu___4 in + FStar_Class_Show.show + FStar_Compiler_Range_Ops.showable_range uu___4 in let uu___4 = FStar_Class_Show.show (FStar_Class_Show.show_tuple3 diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml index efbda6e80c7..003950450d3 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml @@ -1939,7 +1939,8 @@ and (tc_maybe_toplevel_term : then let uu___3 = let uu___4 = FStar_TypeChecker_Env.get_range env1 in - FStar_Class_Show.show FStar_Compiler_Range_Ops.show_range uu___4 in + FStar_Class_Show.show FStar_Compiler_Range_Ops.showable_range + uu___4 in let uu___4 = FStar_Syntax_Print.tag_of_term top in let uu___5 = FStar_Class_Show.show FStar_Syntax_Print.showable_term top in @@ -6753,7 +6754,8 @@ and (check_application_args : if uu___1 then let uu___2 = - FStar_Class_Show.show FStar_Compiler_Range_Ops.show_range + FStar_Class_Show.show + FStar_Compiler_Range_Ops.showable_range head.FStar_Syntax_Syntax.pos in let uu___3 = FStar_Class_Show.show FStar_Syntax_Print.showable_term From aaa939e31c581d1ccc02895d3305b6cd1408ce7b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 17 May 2024 14:54:30 -0700 Subject: [PATCH 208/239] Update expected output --- tests/error-messages/Bug1918.fst.expected | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/error-messages/Bug1918.fst.expected b/tests/error-messages/Bug1918.fst.expected index 62bc6a458eb..1cf2193c673 100644 --- a/tests/error-messages/Bug1918.fst.expected +++ b/tests/error-messages/Bug1918.fst.expected @@ -1,8 +1,8 @@ >> Got issues: [ * Error 228 at Bug1918.fst(11,13-11,14): - - Typeclass resolution failed + - Typeclass resolution failed. - Could not solve constraint Bug1918.mon - - See also FStar.Tactics.Typeclasses.fst(293,6-297,7) + - See also FStar.Tactics.Typeclasses.fst(308,6-312,7) >>] Verified module: Bug1918 From 00439b1fa8807c298b4fb7ad81d8f6d22d209191 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 18 May 2024 17:12:47 -0700 Subject: [PATCH 209/239] Rel: make progress checking in head_matches_delta stricter --- src/typechecker/FStar.TypeChecker.Rel.fst | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.Rel.fst b/src/typechecker/FStar.TypeChecker.Rel.fst index d1511302b51..7a1b35c5ef6 100644 --- a/src/typechecker/FStar.TypeChecker.Rel.fst +++ b/src/typechecker/FStar.TypeChecker.Rel.fst @@ -1400,10 +1400,19 @@ let head_matches_delta env (logical:bool) smt_ok t1 t2 : (match_result & option * in an unfolding call to the normalizer * This made_progress function is checking that we have made progress in unfolding t to t' * See #2184 + * + * GM: Updated 2024/05/18 to check for a discrepancy in syntactic equality, instead of + * eq_tm *not* returning Equal. We can have syntactically equal terms for which eq_tm + * returns unknown, so this code would falsely claim progress. For instance, Tm_let + * nodes are not handled by eq_tm and it always returns unknown. That should probably + * be improved, but in either case I think we want a syntactic check here (which is + * faster too) than eq_tm which is meant for decidable equality. *) let made_progress t t' = - let head, head' = U.head_and_args t |> fst, U.head_and_args t' |> fst in - not (TEQ.eq_tm env head head' = TEQ.Equal) in + let head = U.head_and_args t |> fst in + let head' = U.head_and_args t' |> fst in + not (U.term_eq head head') + in let rec aux retry n_delta t1 t2 = let r = head_matches env t1 t2 in From 17f25dd7da68897d94ac504ad4d49d81c6ada09a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sat, 18 May 2024 17:12:58 -0700 Subject: [PATCH 210/239] snap --- .../generated/FStar_TypeChecker_Rel.ml | 24 +++++++------------ 1 file changed, 8 insertions(+), 16 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml index e212fa19ca2..3d1d18c4bf6 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml @@ -3299,22 +3299,14 @@ let (head_matches_delta : then FStar_Pervasives_Native.Some (t11, t21) else FStar_Pervasives_Native.None)) in let made_progress t t' = - let uu___ = - let uu___1 = - let uu___2 = FStar_Syntax_Util.head_and_args t in - FStar_Pervasives_Native.fst uu___2 in - let uu___2 = - let uu___3 = FStar_Syntax_Util.head_and_args t' in - FStar_Pervasives_Native.fst uu___3 in - (uu___1, uu___2) in - match uu___ with - | (head, head') -> - let uu___1 = - let uu___2 = - FStar_TypeChecker_TermEqAndSimplify.eq_tm env head - head' in - uu___2 = FStar_TypeChecker_TermEqAndSimplify.Equal in - Prims.op_Negation uu___1 in + let head = + let uu___ = FStar_Syntax_Util.head_and_args t in + FStar_Pervasives_Native.fst uu___ in + let head' = + let uu___ = FStar_Syntax_Util.head_and_args t' in + FStar_Pervasives_Native.fst uu___ in + let uu___ = FStar_Syntax_Util.term_eq head head' in + Prims.op_Negation uu___ in let rec aux retry n_delta t11 t21 = let r = head_matches env t11 t21 in (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_RelDelta in From 83479b56430a5aaab0c681f3e011d197bce1a3e7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 19 May 2024 11:43:21 -0700 Subject: [PATCH 211/239] Debug: introduce --debug_all --- src/basic/FStar.Compiler.Debug.fst | 19 +++++++++++++------ src/basic/FStar.Compiler.Debug.fsti | 6 +++++- src/basic/FStar.Options.fst | 15 +++++++++++++++ 3 files changed, 33 insertions(+), 7 deletions(-) diff --git a/src/basic/FStar.Compiler.Debug.fst b/src/basic/FStar.Compiler.Debug.fst index e15cca57957..071f2a0ca44 100644 --- a/src/basic/FStar.Compiler.Debug.fst +++ b/src/basic/FStar.Compiler.Debug.fst @@ -18,11 +18,16 @@ module FStar.Compiler.Debug module BU = FStar.Compiler.Util +(* Mutable state *) +let anyref = BU.mk_ref false +let _debug_all : ref bool = BU.mk_ref false let toggle_list : ref (list (string & ref bool)) = BU.mk_ref [] let register_toggle (k : string) : ref bool = let r = BU.mk_ref false in + if !_debug_all then + r := true; toggle_list := (k, r) :: !toggle_list; r @@ -34,16 +39,15 @@ let get_toggle (k : string) : ref bool = let list_all_toggles () : list string = List.map fst !toggle_list -let anyref = BU.mk_ref false -let any () = !anyref +let any () = !anyref || !_debug_all let enable () = anyref := true let dbg_level = BU.mk_ref 0 -let low () = !dbg_level >= 1 -let medium () = !dbg_level >= 2 -let high () = !dbg_level >= 3 -let extreme () = !dbg_level >= 4 +let low () = !dbg_level >= 1 || !_debug_all +let medium () = !dbg_level >= 2 || !_debug_all +let high () = !dbg_level >= 3 || !_debug_all +let extreme () = !dbg_level >= 4 || !_debug_all let set_level_low () = dbg_level := 1 let set_level_medium () = dbg_level := 2 @@ -66,3 +70,6 @@ let disable_all () : unit = anyref := false; dbg_level := 0; List.iter (fun (_, r) -> r := false) !toggle_list + +let set_debug_all () : unit = + _debug_all := true \ No newline at end of file diff --git a/src/basic/FStar.Compiler.Debug.fsti b/src/basic/FStar.Compiler.Debug.fsti index eba7439f83e..5e0ed78f9a6 100644 --- a/src/basic/FStar.Compiler.Debug.fsti +++ b/src/basic/FStar.Compiler.Debug.fsti @@ -20,7 +20,8 @@ open FStar open FStar.Compiler open FStar.Compiler.Effect -(* Enable debugging. *) +(* Enable debugging. This will make any() return true, but +does not enable any particular toggle. *) val enable () : unit (* Are we doing *any* kind of debugging? *) @@ -48,6 +49,9 @@ val enable_toggles (keys : list string) : unit to false. any() will return false after this. *) val disable_all () : unit +(* Nuclear option: enable ALL debug toggles. *) +val set_debug_all () : unit + (* Not used externally at the moment. *) val set_level_low () : unit val set_level_medium () : unit diff --git a/src/basic/FStar.Options.fst b/src/basic/FStar.Options.fst index 77ccef28cf8..f283a197f87 100644 --- a/src/basic/FStar.Options.fst +++ b/src/basic/FStar.Options.fst @@ -155,6 +155,7 @@ let defaults = ("codegen-lib" , List []); ("defensive" , String "no"); ("debug" , List []); + ("debug_all" , Bool false); ("debug_all_modules" , Bool false); ("dep" , Unset); ("detail_errors" , Bool false); @@ -734,6 +735,18 @@ let rec specs_with_types warn_unsafe : list (char * string * opt_type * Pprint.d o), Accumulated (SimpleStr "debug toggles")), text "Debug toggles (comma-separated list of debug keys)"); + ( noshort, + "debug_all", + PostProcessed ( + (fun o -> + match o with + | Bool true -> + Debug.set_debug_all (); + o + | _ -> failwith "?" + ), Const (Bool true)), + text "Enable all debug toggles. WARNING: this will cause a lot of output!"); + ( noshort, "debug_all_modules", Const (Bool true), @@ -1448,6 +1461,7 @@ let settable = function | "compat_pre_typed_indexed_effects" | "disallow_unification_guards" | "debug" + | "debug_all" | "debug_all_modules" | "defensive" | "detail_errors" @@ -1939,6 +1953,7 @@ let trivial_pre_for_unannotated_effectful_fns () = get_trivial_pre_for_unannotated_effectful_fns () let debug_keys () = lookup_opt "debug" as_comma_string_list +let debug_all () = lookup_opt "debug_all" as_bool let debug_all_modules () = lookup_opt "debug_all_modules" as_bool let with_saved_options f = From 589ff756a1d636bb9a9514f67ad4e6f5b1362247 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 19 May 2024 12:20:23 -0700 Subject: [PATCH 212/239] Debug/Options: make sure to restore debugging state after popping options --- src/basic/FStar.Compiler.Debug.fst | 24 +++++++++++++ src/basic/FStar.Compiler.Debug.fsti | 6 ++++ src/basic/FStar.Options.fst | 54 ++++++++++++++++++----------- 3 files changed, 63 insertions(+), 21 deletions(-) diff --git a/src/basic/FStar.Compiler.Debug.fst b/src/basic/FStar.Compiler.Debug.fst index 071f2a0ca44..c15927371a8 100644 --- a/src/basic/FStar.Compiler.Debug.fst +++ b/src/basic/FStar.Compiler.Debug.fst @@ -24,6 +24,18 @@ let _debug_all : ref bool = BU.mk_ref false let toggle_list : ref (list (string & ref bool)) = BU.mk_ref [] +type saved_state = { + toggles : list (string & bool); + any : bool; + all : bool; +} + +let snapshot () : saved_state = { + toggles = !toggle_list |> List.map (fun (k, r) -> (k, !r)); + any = !anyref; + all = !_debug_all; +} + let register_toggle (k : string) : ref bool = let r = BU.mk_ref false in if !_debug_all then @@ -36,6 +48,18 @@ let get_toggle (k : string) : ref bool = | Some (_, r) -> r | None -> register_toggle k +let restore (snapshot : saved_state) : unit = + (* Set everything to false, then set all the saved ones + to true. *) + !toggle_list |> List.iter (fun (_, r) -> r := false); + snapshot.toggles |> List.iter (fun (k, b) -> + let r = get_toggle k in + r := b); + (* Also restore these references. *) + anyref := snapshot.any; + _debug_all := snapshot.all; + () + let list_all_toggles () : list string = List.map fst !toggle_list diff --git a/src/basic/FStar.Compiler.Debug.fsti b/src/basic/FStar.Compiler.Debug.fsti index 5e0ed78f9a6..e5ab5dc3ad0 100644 --- a/src/basic/FStar.Compiler.Debug.fsti +++ b/src/basic/FStar.Compiler.Debug.fsti @@ -20,6 +20,12 @@ open FStar open FStar.Compiler open FStar.Compiler.Effect +(* State handling for this module. Used by FStar.Options, which +is the only module that modifies the debug state. *) +val saved_state : Type0 +val snapshot () : saved_state +val restore (s:saved_state) : unit + (* Enable debugging. This will make any() return true, but does not enable any particular toggle. *) val enable () : unit diff --git a/src/basic/FStar.Options.fst b/src/basic/FStar.Options.fst index f283a197f87..29c84f73fcf 100644 --- a/src/basic/FStar.Options.fst +++ b/src/basic/FStar.Options.fst @@ -89,42 +89,54 @@ let copy_optionstate m = Util.smap_copy m * * No stack should ever be empty! Any of these failwiths should never be * triggered externally. IOW, the API should protect this invariant. + * + * We also keep a snapshot of the Debug module's state. *) -let fstar_options : ref (list (list optionstate)) = Util.mk_ref [] +let fstar_options : ref (list (list (Debug.saved_state & optionstate))) = Util.mk_ref [] -let internal_peek () = List.hd (List.hd !fstar_options) +let internal_peek () = snd <| List.hd (List.hd !fstar_options) let peek () = copy_optionstate (internal_peek()) let pop () = // already signal-atomic - match !fstar_options with - | [] - | [_] -> failwith "TOO MANY POPS!" - | _::tl -> fstar_options := tl + match !fstar_options with + | [] + | [_] -> failwith "TOO MANY POPS!" + | _::tl -> + fstar_options := tl + let push () = // already signal-atomic - fstar_options := List.map copy_optionstate (List.hd !fstar_options) :: !fstar_options + let new_st = + List.hd !fstar_options |> + List.map (fun (dbg, opts) -> (dbg, copy_optionstate opts)) + in + fstar_options := new_st :: !fstar_options let internal_pop () = - let curstack = List.hd !fstar_options in - match curstack with - | [] -> failwith "impossible: empty current option stack" - | [_] -> false - | _::tl -> (fstar_options := tl :: List.tl !fstar_options; true) + let curstack = List.hd !fstar_options in + match curstack with + | [] -> failwith "impossible: empty current option stack" + | [_] -> false + | _::tl -> + fstar_options := tl :: List.tl !fstar_options; + Debug.restore (fst (List.hd tl)); + true let internal_push () = - let curstack = List.hd !fstar_options in - let stack' = copy_optionstate (List.hd curstack) :: curstack in - fstar_options := stack' :: List.tl !fstar_options + let curstack = List.hd !fstar_options in + let stack' = (Debug.snapshot (), copy_optionstate (snd <| List.hd curstack)) :: curstack in + fstar_options := stack' :: List.tl !fstar_options let set o = - match !fstar_options with - | [] -> failwith "set on empty option stack" - | []::_ -> failwith "set on empty current option stack" - | (_::tl)::os -> fstar_options := ((o::tl)::os) + match !fstar_options with + | [] -> failwith "set on empty option stack" + | []::_ -> failwith "set on empty current option stack" + | ((dbg, _)::tl)::os -> + fstar_options := (((dbg, o)::tl)::os) let snapshot () = Common.snapshot push fstar_options () let rollback depth = Common.rollback pop fstar_options depth let set_option k v = - let map = internal_peek() in + let map : optionstate = internal_peek() in if k = "report_assumes" then match Util.smap_try_find map k with | Some (String "error") -> @@ -282,7 +294,7 @@ let init () = let clear () = let o = Util.smap_create 50 in - fstar_options := [[o]]; //clear and reset the options stack + fstar_options := [[(Debug.snapshot (), o)]]; //clear and reset the options stack init() let _run = clear() From f21619abc0a53f6f7bf1dad4091cf03093dbe824 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 19 May 2024 12:23:27 -0700 Subject: [PATCH 213/239] snap --- .../generated/FStar_Compiler_Debug.ml | 84 +- ocaml/fstar-lib/generated/FStar_Options.ml | 1217 +++++++++-------- 2 files changed, 705 insertions(+), 596 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Compiler_Debug.ml b/ocaml/fstar-lib/generated/FStar_Compiler_Debug.ml index 5263a316259..2315a9fdfe6 100644 --- a/ocaml/fstar-lib/generated/FStar_Compiler_Debug.ml +++ b/ocaml/fstar-lib/generated/FStar_Compiler_Debug.ml @@ -1,16 +1,47 @@ open Prims +let (anyref : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Util.mk_ref false +let (_debug_all : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Util.mk_ref false let (toggle_list : (Prims.string * Prims.bool FStar_Compiler_Effect.ref) Prims.list FStar_Compiler_Effect.ref) = FStar_Compiler_Util.mk_ref [] +type saved_state = + { + toggles: (Prims.string * Prims.bool) Prims.list ; + any: Prims.bool ; + all: Prims.bool } +let (__proj__Mksaved_state__item__toggles : + saved_state -> (Prims.string * Prims.bool) Prims.list) = + fun projectee -> match projectee with | { toggles; any; all;_} -> toggles +let (__proj__Mksaved_state__item__any : saved_state -> Prims.bool) = + fun projectee -> match projectee with | { toggles; any; all;_} -> any +let (__proj__Mksaved_state__item__all : saved_state -> Prims.bool) = + fun projectee -> match projectee with | { toggles; any; all;_} -> all +let (snapshot : unit -> saved_state) = + fun uu___ -> + let uu___1 = + let uu___2 = FStar_Compiler_Effect.op_Bang toggle_list in + FStar_Compiler_List.map + (fun uu___3 -> + match uu___3 with + | (k, r) -> + let uu___4 = FStar_Compiler_Effect.op_Bang r in (k, uu___4)) + uu___2 in + let uu___2 = FStar_Compiler_Effect.op_Bang anyref in + let uu___3 = FStar_Compiler_Effect.op_Bang _debug_all in + { toggles = uu___1; any = uu___2; all = uu___3 } let (register_toggle : Prims.string -> Prims.bool FStar_Compiler_Effect.ref) = fun k -> let r = FStar_Compiler_Util.mk_ref false in - (let uu___1 = - let uu___2 = FStar_Compiler_Effect.op_Bang toggle_list in (k, r) :: - uu___2 in - FStar_Compiler_Effect.op_Colon_Equals toggle_list uu___1); + (let uu___1 = FStar_Compiler_Effect.op_Bang _debug_all in + if uu___1 then FStar_Compiler_Effect.op_Colon_Equals r true else ()); + (let uu___2 = + let uu___3 = FStar_Compiler_Effect.op_Bang toggle_list in (k, r) :: + uu___3 in + FStar_Compiler_Effect.op_Colon_Equals toggle_list uu___2); r let (get_toggle : Prims.string -> Prims.bool FStar_Compiler_Effect.ref) = fun k -> @@ -21,34 +52,53 @@ let (get_toggle : Prims.string -> Prims.bool FStar_Compiler_Effect.ref) = match uu___ with | FStar_Pervasives_Native.Some (uu___1, r) -> r | FStar_Pervasives_Native.None -> register_toggle k +let (restore : saved_state -> unit) = + fun snapshot1 -> + (let uu___1 = FStar_Compiler_Effect.op_Bang toggle_list in + FStar_Compiler_List.iter + (fun uu___2 -> + match uu___2 with + | (uu___3, r) -> FStar_Compiler_Effect.op_Colon_Equals r false) + uu___1); + FStar_Compiler_List.iter + (fun uu___2 -> + match uu___2 with + | (k, b) -> + let r = get_toggle k in + FStar_Compiler_Effect.op_Colon_Equals r b) snapshot1.toggles; + FStar_Compiler_Effect.op_Colon_Equals anyref snapshot1.any; + FStar_Compiler_Effect.op_Colon_Equals _debug_all snapshot1.all let (list_all_toggles : unit -> Prims.string Prims.list) = fun uu___ -> let uu___1 = FStar_Compiler_Effect.op_Bang toggle_list in FStar_Compiler_List.map FStar_Pervasives_Native.fst uu___1 -let (anyref : Prims.bool FStar_Compiler_Effect.ref) = - FStar_Compiler_Util.mk_ref false let (any : unit -> Prims.bool) = - fun uu___ -> FStar_Compiler_Effect.op_Bang anyref + fun uu___ -> + (FStar_Compiler_Effect.op_Bang anyref) || + (FStar_Compiler_Effect.op_Bang _debug_all) let (enable : unit -> unit) = fun uu___ -> FStar_Compiler_Effect.op_Colon_Equals anyref true let (dbg_level : Prims.int FStar_Compiler_Effect.ref) = FStar_Compiler_Util.mk_ref Prims.int_zero let (low : unit -> Prims.bool) = fun uu___ -> - let uu___1 = FStar_Compiler_Effect.op_Bang dbg_level in - uu___1 >= Prims.int_one + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_level in + uu___1 >= Prims.int_one) || (FStar_Compiler_Effect.op_Bang _debug_all) let (medium : unit -> Prims.bool) = fun uu___ -> - let uu___1 = FStar_Compiler_Effect.op_Bang dbg_level in - uu___1 >= (Prims.of_int (2)) + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_level in + uu___1 >= (Prims.of_int (2))) || + (FStar_Compiler_Effect.op_Bang _debug_all) let (high : unit -> Prims.bool) = fun uu___ -> - let uu___1 = FStar_Compiler_Effect.op_Bang dbg_level in - uu___1 >= (Prims.of_int (3)) + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_level in + uu___1 >= (Prims.of_int (3))) || + (FStar_Compiler_Effect.op_Bang _debug_all) let (extreme : unit -> Prims.bool) = fun uu___ -> - let uu___1 = FStar_Compiler_Effect.op_Bang dbg_level in - uu___1 >= (Prims.of_int (4)) + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_level in + uu___1 >= (Prims.of_int (4))) || + (FStar_Compiler_Effect.op_Bang _debug_all) let (set_level_low : unit -> unit) = fun uu___ -> FStar_Compiler_Effect.op_Colon_Equals dbg_level Prims.int_one let (set_level_medium : unit -> unit) = @@ -88,4 +138,6 @@ let (disable_all : unit -> unit) = (fun uu___4 -> match uu___4 with | (uu___5, r) -> FStar_Compiler_Effect.op_Colon_Equals r false) - uu___3) \ No newline at end of file + uu___3) +let (set_debug_all : unit -> unit) = + fun uu___ -> FStar_Compiler_Effect.op_Colon_Equals _debug_all true \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Options.ml b/ocaml/fstar-lib/generated/FStar_Options.ml index 9de0d1fb33e..893a4080ab5 100644 --- a/ocaml/fstar-lib/generated/FStar_Options.ml +++ b/ocaml/fstar-lib/generated/FStar_Options.ml @@ -165,14 +165,17 @@ let copy_optionstate : 'uuuuu . 'uuuuu FStar_Compiler_Util.smap -> 'uuuuu FStar_Compiler_Util.smap = fun m -> FStar_Compiler_Util.smap_copy m let (fstar_options : - optionstate Prims.list Prims.list FStar_Compiler_Effect.ref) = - FStar_Compiler_Util.mk_ref [] + (FStar_Compiler_Debug.saved_state * optionstate) Prims.list Prims.list + FStar_Compiler_Effect.ref) + = FStar_Compiler_Util.mk_ref [] let (internal_peek : unit -> optionstate) = fun uu___ -> let uu___1 = - let uu___2 = FStar_Compiler_Effect.op_Bang fstar_options in + let uu___2 = + let uu___3 = FStar_Compiler_Effect.op_Bang fstar_options in + FStar_Compiler_List.hd uu___3 in FStar_Compiler_List.hd uu___2 in - FStar_Compiler_List.hd uu___1 + FStar_Pervasives_Native.snd uu___1 let (peek : unit -> optionstate) = fun uu___ -> let uu___1 = internal_peek () in copy_optionstate uu___1 let (pop : unit -> unit) = @@ -184,14 +187,18 @@ let (pop : unit -> unit) = | uu___2::tl -> FStar_Compiler_Effect.op_Colon_Equals fstar_options tl let (push : unit -> unit) = fun uu___ -> + let new_st = + let uu___1 = + let uu___2 = FStar_Compiler_Effect.op_Bang fstar_options in + FStar_Compiler_List.hd uu___2 in + FStar_Compiler_List.map + (fun uu___2 -> + match uu___2 with + | (dbg, opts) -> + let uu___3 = copy_optionstate opts in (dbg, uu___3)) uu___1 in let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = FStar_Compiler_Effect.op_Bang fstar_options in - FStar_Compiler_List.hd uu___4 in - FStar_Compiler_List.map copy_optionstate uu___3 in - let uu___3 = FStar_Compiler_Effect.op_Bang fstar_options in uu___2 :: - uu___3 in + let uu___2 = FStar_Compiler_Effect.op_Bang fstar_options in new_st :: + uu___2 in FStar_Compiler_Effect.op_Colon_Equals fstar_options uu___1 let (internal_pop : unit -> Prims.bool) = fun uu___ -> @@ -210,6 +217,10 @@ let (internal_pop : unit -> Prims.bool) = FStar_Compiler_List.tl uu___5 in tl :: uu___4 in FStar_Compiler_Effect.op_Colon_Equals fstar_options uu___3); + (let uu___4 = + let uu___5 = FStar_Compiler_List.hd tl in + FStar_Pervasives_Native.fst uu___5 in + FStar_Compiler_Debug.restore uu___4); true) let (internal_push : unit -> unit) = fun uu___ -> @@ -218,8 +229,13 @@ let (internal_push : unit -> unit) = FStar_Compiler_List.hd uu___1 in let stack' = let uu___1 = - let uu___2 = FStar_Compiler_List.hd curstack in - copy_optionstate uu___2 in + let uu___2 = FStar_Compiler_Debug.snapshot () in + let uu___3 = + let uu___4 = + let uu___5 = FStar_Compiler_List.hd curstack in + FStar_Pervasives_Native.snd uu___5 in + copy_optionstate uu___4 in + (uu___2, uu___3) in uu___1 :: curstack in let uu___1 = let uu___2 = @@ -234,8 +250,9 @@ let (set : optionstate -> unit) = | [] -> FStar_Compiler_Effect.failwith "set on empty option stack" | []::uu___1 -> FStar_Compiler_Effect.failwith "set on empty current option stack" - | (uu___1::tl)::os -> - FStar_Compiler_Effect.op_Colon_Equals fstar_options ((o :: tl) :: os) + | ((dbg, uu___1)::tl)::os -> + FStar_Compiler_Effect.op_Colon_Equals fstar_options (((dbg, o) :: tl) + :: os) let (snapshot : unit -> (Prims.int * unit)) = fun uu___ -> FStar_Common.snapshot push fstar_options () let (rollback : Prims.int FStar_Pervasives_Native.option -> unit) = @@ -272,6 +289,7 @@ let (defaults : (Prims.string * option_val) Prims.list) = ("codegen-lib", (List [])); ("defensive", (String "no")); ("debug", (List [])); + ("debug_all", (Bool false)); ("debug_all_modules", (Bool false)); ("dep", Unset); ("detail_errors", (Bool false)); @@ -394,7 +412,14 @@ let (init : unit -> unit) = let (clear : unit -> unit) = fun uu___ -> let o = FStar_Compiler_Util.smap_create (Prims.of_int (50)) in - FStar_Compiler_Effect.op_Colon_Equals fstar_options [[o]]; init () + (let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = FStar_Compiler_Debug.snapshot () in (uu___5, o) in + [uu___4] in + [uu___3] in + FStar_Compiler_Effect.op_Colon_Equals fstar_options uu___2); + init () let (_run : unit) = clear () let (get_option : Prims.string -> option_val) = fun s -> @@ -980,7 +1005,7 @@ let (interp_quake_arg : Prims.string -> (Prims.int * Prims.int * Prims.bool)) let uu___ = ios f1 in let uu___1 = ios f2 in (uu___, uu___1, true) else FStar_Compiler_Effect.failwith "unexpected value for --quake" | uu___ -> FStar_Compiler_Effect.failwith "unexpected value for --quake" -let (uu___443 : (((Prims.string -> unit) -> unit) * (Prims.string -> unit))) +let (uu___450 : (((Prims.string -> unit) -> unit) * (Prims.string -> unit))) = let cb = FStar_Compiler_Util.mk_ref FStar_Pervasives_Native.None in let set1 f = @@ -992,11 +1017,11 @@ let (uu___443 : (((Prims.string -> unit) -> unit) * (Prims.string -> unit))) | FStar_Pervasives_Native.Some f -> f msg in (set1, call) let (set_option_warning_callback_aux : (Prims.string -> unit) -> unit) = - match uu___443 with + match uu___450 with | (set_option_warning_callback_aux1, option_warning_callback) -> set_option_warning_callback_aux1 let (option_warning_callback : Prims.string -> unit) = - match uu___443 with + match uu___450 with | (set_option_warning_callback_aux1, option_warning_callback1) -> option_warning_callback1 let (set_option_warning_callback : (Prims.string -> unit) -> unit) = @@ -1146,186 +1171,198 @@ let rec (specs_with_types : let uu___30 = let uu___31 = text - "Enable to make the effect of --debug apply to every module processed by the compiler, including dependencies." in - (FStar_Getopt.noshort, - "debug_all_modules", - (Const (Bool true)), uu___31) in + "Enable all debug toggles. WARNING: this will cause a lot of output!" in + (FStar_Getopt.noshort, "debug_all", + (PostProcessed + ((fun o -> + match o with + | Bool (true) -> + (FStar_Compiler_Debug.set_debug_all + (); + o) + | uu___32 -> + FStar_Compiler_Effect.failwith + "?"), (Const (Bool true)))), + uu___31) in let uu___31 = let uu___32 = let uu___33 = - let uu___34 = - text - "Enable several internal sanity checks, useful to track bugs and report issues." in + text + "Enable to make the effect of --debug apply to every module processed by the compiler, including dependencies." in + (FStar_Getopt.noshort, + "debug_all_modules", + (Const (Bool true)), uu___33) in + let uu___33 = + let uu___34 = let uu___35 = let uu___36 = - let uu___37 = - let uu___38 = - text - "if 'no', no checks are performed" in + text + "Enable several internal sanity checks, useful to track bugs and report issues." in + let uu___37 = + let uu___38 = let uu___39 = let uu___40 = text - "if 'warn', checks are performed and raise a warning when they fail" in + "if 'no', no checks are performed" in let uu___41 = let uu___42 = text - "if 'error, like 'warn', but the compiler raises a hard error instead" in + "if 'warn', checks are performed and raise a warning when they fail" in let uu___43 = let uu___44 = text - "if 'abort, like 'warn', but the compiler immediately aborts on an error" in - [uu___44] in + "if 'error, like 'warn', but the compiler raises a hard error instead" in + let uu___45 = + let uu___46 = + text + "if 'abort, like 'warn', but the compiler immediately aborts on an error" in + [uu___46] in + uu___44 :: uu___45 in uu___42 :: uu___43 in uu___40 :: uu___41 in - uu___38 :: uu___39 in - FStar_Errors_Msg.bulleted uu___37 in - let uu___37 = text "(default 'no')" in - FStar_Pprint.op_Hat_Slash_Hat - uu___36 uu___37 in - FStar_Pprint.op_Hat_Hat uu___34 - uu___35 in - (FStar_Getopt.noshort, "defensive", - (EnumStr - ["no"; "warn"; "error"; "abort"]), - uu___33) in - let uu___33 = - let uu___34 = - let uu___35 = - let uu___36 = - text - "Output the transitive closure of the full dependency graph in three formats:" in + FStar_Errors_Msg.bulleted + uu___39 in + let uu___39 = + text "(default 'no')" in + FStar_Pprint.op_Hat_Slash_Hat + uu___38 uu___39 in + FStar_Pprint.op_Hat_Hat uu___36 + uu___37 in + (FStar_Getopt.noshort, "defensive", + (EnumStr + ["no"; "warn"; "error"; "abort"]), + uu___35) in + let uu___35 = + let uu___36 = let uu___37 = let uu___38 = - let uu___39 = - text - "'graph': a format suitable the 'dot' tool from 'GraphViz'" in + text + "Output the transitive closure of the full dependency graph in three formats:" in + let uu___39 = let uu___40 = let uu___41 = text - "'full': a format suitable for 'make', including dependences for producing .ml and .krml files" in + "'graph': a format suitable the 'dot' tool from 'GraphViz'" in let uu___42 = let uu___43 = text - "'make': (deprecated) a format suitable for 'make', including only dependences among source files" in - [uu___43] in + "'full': a format suitable for 'make', including dependences for producing .ml and .krml files" in + let uu___44 = + let uu___45 = + text + "'make': (deprecated) a format suitable for 'make', including only dependences among source files" in + [uu___45] in + uu___43 :: uu___44 in uu___41 :: uu___42 in - uu___39 :: uu___40 in - FStar_Errors_Msg.bulleted uu___38 in - FStar_Pprint.op_Hat_Hat uu___36 - uu___37 in - (FStar_Getopt.noshort, "dep", - (EnumStr - ["make"; "graph"; "full"; "raw"]), - uu___35) in - let uu___35 = - let uu___36 = - let uu___37 = - text - "Emit a detailed error report by asking the SMT solver many queries; will take longer" in - (FStar_Getopt.noshort, - "detail_errors", - (Const (Bool true)), uu___37) in + FStar_Errors_Msg.bulleted + uu___40 in + FStar_Pprint.op_Hat_Hat uu___38 + uu___39 in + (FStar_Getopt.noshort, "dep", + (EnumStr + ["make"; + "graph"; + "full"; + "raw"]), uu___37) in let uu___37 = let uu___38 = let uu___39 = text - "Emit a detailed report for proof whose unsat core fails to replay" in + "Emit a detailed error report by asking the SMT solver many queries; will take longer" in (FStar_Getopt.noshort, - "detail_hint_replay", + "detail_errors", (Const (Bool true)), uu___39) in let uu___39 = let uu___40 = let uu___41 = text - "Print out this module as it passes through the compiler pipeline" in + "Emit a detailed report for proof whose unsat core fails to replay" in (FStar_Getopt.noshort, - "dump_module", - (Accumulated - (SimpleStr "module_name")), - uu___41) in + "detail_hint_replay", + (Const (Bool true)), uu___41) in let uu___41 = let uu___42 = let uu___43 = text - "Try to solve subtyping constraints at each binder (loses precision but may be slightly more efficient)" in + "Print out this module as it passes through the compiler pipeline" in (FStar_Getopt.noshort, - "eager_subtyping", - (Const (Bool true)), + "dump_module", + (Accumulated + (SimpleStr "module_name")), uu___43) in let uu___43 = let uu___44 = let uu___45 = text - "Print context information for each error or warning raised (default false)" in + "Try to solve subtyping constraints at each binder (loses precision but may be slightly more efficient)" in (FStar_Getopt.noshort, - "error_contexts", - BoolStr, uu___45) in + "eager_subtyping", + (Const (Bool true)), + uu___45) in let uu___45 = let uu___46 = let uu___47 = text - "These options are set in extensions option map. Keys are usually namespaces separated by \":\". E.g., 'pulse:verbose=1;my:extension:option=xyz;foo:bar=baz'. These options are typically interpreted by extensions. Any later use of --ext over the same key overrides the old value. An entry 'e' that is not of the form 'a=b' is treated as 'e=1', i.e., 'e' associated with string \"1\"." in + "Print context information for each error or warning raised (default false)" in (FStar_Getopt.noshort, - "ext", - (ReverseAccumulated - (SimpleStr - "One or more semicolon separated occurrences of key-value pairs")), - uu___47) in + "error_contexts", + BoolStr, uu___47) in let uu___47 = let uu___48 = let uu___49 = text - "Extract only those modules whose names or namespaces match the provided options. 'TargetName' ranges over {OCaml, krml, FSharp, Plugin, Extension}. A 'ModuleSelector' is a space or comma-separated list of '[+|-]( * | namespace | module)'. For example --extract 'OCaml:A -A.B' --extract 'krml:A -A.C' --extract '*' means for OCaml, extract everything in the A namespace only except A.B; for krml, extract everything in the A namespace only except A.C; for everything else, extract everything. Note, the '+' is optional: --extract '+A' and --extract 'A' mean the same thing. Note also that '--extract A' applies both to a module named 'A' and to any module in the 'A' namespace Multiple uses of this option accumulate, e.g., --extract A --extract B is interpreted as --extract 'A B'." in + "These options are set in extensions option map. Keys are usually namespaces separated by \":\". E.g., 'pulse:verbose=1;my:extension:option=xyz;foo:bar=baz'. These options are typically interpreted by extensions. Any later use of --ext over the same key overrides the old value. An entry 'e' that is not of the form 'a=b' is treated as 'e=1', i.e., 'e' associated with string \"1\"." in (FStar_Getopt.noshort, - "extract", - (Accumulated + "ext", + (ReverseAccumulated (SimpleStr - "One or more semicolon separated occurrences of '[TargetName:]ModuleSelector'")), + "One or more semicolon separated occurrences of key-value pairs")), uu___49) in let uu___49 = let uu___50 = let uu___51 = text - "Deprecated: use --extract instead; Only extract the specified modules (instead of the possibly-partial dependency graph)" in + "Extract only those modules whose names or namespaces match the provided options. 'TargetName' ranges over {OCaml, krml, FSharp, Plugin, Extension}. A 'ModuleSelector' is a space or comma-separated list of '[+|-]( * | namespace | module)'. For example --extract 'OCaml:A -A.B' --extract 'krml:A -A.C' --extract '*' means for OCaml, extract everything in the A namespace only except A.B; for krml, extract everything in the A namespace only except A.C; for everything else, extract everything. Note, the '+' is optional: --extract '+A' and --extract 'A' mean the same thing. Note also that '--extract A' applies both to a module named 'A' and to any module in the 'A' namespace Multiple uses of this option accumulate, e.g., --extract A --extract B is interpreted as --extract 'A B'." in (FStar_Getopt.noshort, - "extract_module", + "extract", (Accumulated - (PostProcessed - (pp_lowercase, - (SimpleStr - "module_name")))), + (SimpleStr + "One or more semicolon separated occurrences of '[TargetName:]ModuleSelector'")), uu___51) in let uu___51 = let uu___52 = let uu___53 = text - "Deprecated: use --extract instead; Only extract modules in the specified namespace" in + "Deprecated: use --extract instead; Only extract the specified modules (instead of the possibly-partial dependency graph)" in (FStar_Getopt.noshort, - "extract_namespace", + "extract_module", (Accumulated (PostProcessed (pp_lowercase, ( SimpleStr - "namespace name")))), + "module_name")))), uu___53) in let uu___53 = let uu___54 = let uu___55 = text - "Explicitly break the abstraction imposed by the interface of any implementation file that appears on the command line (use with care!)" in + "Deprecated: use --extract instead; Only extract modules in the specified namespace" in (FStar_Getopt.noshort, - "expose_interfaces", - (Const - (Bool true)), + "extract_namespace", + (Accumulated + (PostProcessed + (pp_lowercase, + (SimpleStr + "namespace name")))), uu___55) in let uu___55 = let uu___56 = let uu___57 = text - "Don't print unification variable numbers" in + "Explicitly break the abstraction imposed by the interface of any implementation file that appears on the command line (use with care!)" in (FStar_Getopt.noshort, - "hide_uvar_nums", + "expose_interfaces", (Const (Bool true)), uu___57) in @@ -1333,25 +1370,26 @@ let rec (specs_with_types : let uu___58 = let uu___59 = text - "Read/write hints to dir/module_name.hints (instead of placing hint-file alongside source file)" in + "Don't print unification variable numbers" in (FStar_Getopt.noshort, - "hint_dir", - (PostProcessed - (pp_validate_dir, - (PathStr - "dir"))), + "hide_uvar_nums", + (Const + (Bool + true)), uu___59) in let uu___59 = let uu___60 = let uu___61 = text - "Read/write hints to path (instead of module-specific hints files; overrides hint_dir)" in + "Read/write hints to dir/module_name.hints (instead of placing hint-file alongside source file)" in (FStar_Getopt.noshort, - "hint_file", + "hint_dir", ( - PathStr - "path"), + PostProcessed + (pp_validate_dir, + (PathStr + "dir"))), uu___61) in let uu___61 = let uu___62 @@ -1359,11 +1397,11 @@ let rec (specs_with_types : let uu___63 = text - "Use to generate hints for definitions which do not have them. The command will receive a JSON representation of the query, the type of the top-level definition involved, and the full SMT theory, and must output a comma separated list of facts to be used." in + "Read/write hints to path (instead of module-specific hints files; overrides hint_dir)" in (FStar_Getopt.noshort, - "hint_hook", - (SimpleStr - "command"), + "hint_file", + (PathStr + "path"), uu___63) in let uu___63 = @@ -1372,12 +1410,11 @@ let rec (specs_with_types : let uu___65 = text - "Print information regarding hints (deprecated; use --query_stats instead)" in + "Use to generate hints for definitions which do not have them. The command will receive a JSON representation of the query, the type of the top-level definition involved, and the full SMT theory, and must output a comma separated list of facts to be used." in (FStar_Getopt.noshort, - "hint_info", - (Const - (Bool - true)), + "hint_hook", + (SimpleStr + "command"), uu___65) in let uu___65 = @@ -1386,9 +1423,9 @@ let rec (specs_with_types : let uu___67 = text - "Legacy interactive mode; reads input from stdin" in + "Print information regarding hints (deprecated; use --query_stats instead)" in (FStar_Getopt.noshort, - "in", + "hint_info", (Const (Bool true)), @@ -1400,9 +1437,9 @@ let rec (specs_with_types : let uu___69 = text - "JSON-based interactive mode for IDEs" in + "Legacy interactive mode; reads input from stdin" in (FStar_Getopt.noshort, - "ide", + "in", (Const (Bool true)), @@ -1414,9 +1451,9 @@ let rec (specs_with_types : let uu___71 = text - "Disable identifier tables in IDE mode (temporary workaround useful in Steel)" in + "JSON-based interactive mode for IDEs" in (FStar_Getopt.noshort, - "ide_id_info_off", + "ide", (Const (Bool true)), @@ -1428,9 +1465,9 @@ let rec (specs_with_types : let uu___73 = text - "Language Server Protocol-based interactive mode for IDEs" in + "Disable identifier tables in IDE mode (temporary workaround useful in Steel)" in (FStar_Getopt.noshort, - "lsp", + "ide_id_info_off", (Const (Bool true)), @@ -1442,12 +1479,12 @@ let rec (specs_with_types : let uu___75 = text - "A directory in which to search for files included on the command line" in + "Language Server Protocol-based interactive mode for IDEs" in (FStar_Getopt.noshort, - "include", - (ReverseAccumulated - (PathStr - "path")), + "lsp", + (Const + (Bool + true)), uu___75) in let uu___75 = @@ -1456,12 +1493,12 @@ let rec (specs_with_types : let uu___77 = text - "Parses and prettyprints the files included on the command line" in + "A directory in which to search for files included on the command line" in (FStar_Getopt.noshort, - "print", - (Const - (Bool - true)), + "include", + (ReverseAccumulated + (PathStr + "path")), uu___77) in let uu___77 = @@ -1470,9 +1507,9 @@ let rec (specs_with_types : let uu___79 = text - "Parses and prettyprints in place the files included on the command line" in + "Parses and prettyprints the files included on the command line" in (FStar_Getopt.noshort, - "print_in_place", + "print", (Const (Bool true)), @@ -1484,9 +1521,9 @@ let rec (specs_with_types : let uu___81 = text - "Force checking the files given as arguments even if they have valid checked files" in - (102, - "force", + "Parses and prettyprints in place the files included on the command line" in + (FStar_Getopt.noshort, + "print_in_place", (Const (Bool true)), @@ -1498,26 +1535,40 @@ let rec (specs_with_types : let uu___83 = text + "Force checking the files given as arguments even if they have valid checked files" in + (102, + "force", + (Const + (Bool + true)), + uu___83) in + let uu___83 + = + let uu___84 + = + let uu___85 + = + text "Set initial_fuel and max_fuel at once" in (FStar_Getopt.noshort, "fuel", (PostProcessed ((fun - uu___84 + uu___86 -> - match uu___84 + match uu___86 with | String s -> let p f = - let uu___85 + let uu___87 = FStar_Compiler_Util.int_of_string f in Int - uu___85 in - let uu___85 + uu___87 in + let uu___87 = match FStar_Compiler_Util.split @@ -1531,40 +1582,40 @@ let rec (specs_with_types : -> (f1, f2) | - uu___86 + uu___88 -> FStar_Compiler_Effect.failwith "unexpected value for --fuel" in - (match uu___85 + (match uu___87 with | (min, max) -> (( - let uu___87 + let uu___89 = p min in set_option "initial_fuel" - uu___87); - (let uu___88 + uu___89); + (let uu___90 = p max in set_option "max_fuel" - uu___88); + uu___90); String s)) | - uu___85 + uu___87 -> FStar_Compiler_Effect.failwith "impos"), (SimpleStr "non-negative integer or pair of non-negative integers"))), - uu___83) in - let uu___83 + uu___85) in + let uu___85 = - let uu___84 + let uu___86 = - let uu___85 + let uu___87 = text "Set initial_ifuel and max_ifuel at once" in @@ -1572,21 +1623,21 @@ let rec (specs_with_types : "ifuel", (PostProcessed ((fun - uu___86 + uu___88 -> - match uu___86 + match uu___88 with | String s -> let p f = - let uu___87 + let uu___89 = FStar_Compiler_Util.int_of_string f in Int - uu___87 in - let uu___87 + uu___89 in + let uu___89 = match FStar_Compiler_Util.split @@ -1600,40 +1651,40 @@ let rec (specs_with_types : -> (f1, f2) | - uu___88 + uu___90 -> FStar_Compiler_Effect.failwith "unexpected value for --ifuel" in - (match uu___87 + (match uu___89 with | (min, max) -> (( - let uu___89 + let uu___91 = p min in set_option "initial_ifuel" - uu___89); - (let uu___90 + uu___91); + (let uu___92 = p max in set_option "max_ifuel" - uu___90); + uu___92); String s)) | - uu___87 + uu___89 -> FStar_Compiler_Effect.failwith "impos"), (SimpleStr "non-negative integer or pair of non-negative integers"))), - uu___85) in - let uu___85 + uu___87) in + let uu___87 = - let uu___86 + let uu___88 = - let uu___87 + let uu___89 = text "Number of unrolling of recursive functions to try initially (default 2)" in @@ -1641,12 +1692,12 @@ let rec (specs_with_types : "initial_fuel", (IntStr "non-negative integer"), - uu___87) in - let uu___87 + uu___89) in + let uu___89 = - let uu___88 + let uu___90 = - let uu___89 + let uu___91 = text "Number of unrolling of inductive datatypes to try at first (default 1)" in @@ -1654,24 +1705,24 @@ let rec (specs_with_types : "initial_ifuel", (IntStr "non-negative integer"), - uu___89) in - let uu___89 + uu___91) in + let uu___91 = - let uu___90 + let uu___92 = - let uu___91 + let uu___93 = text "Retain comments in the logged SMT queries (requires --log_queries or --log_failing_queries; default true)" in (FStar_Getopt.noshort, "keep_query_captions", BoolStr, - uu___91) in - let uu___91 + uu___93) in + let uu___93 = - let uu___92 + let uu___94 = - let uu___93 + let uu___95 = text "Run the lax-type checker only (admit all verification conditions)" in @@ -1679,7 +1730,7 @@ let rec (specs_with_types : "lax", (WithSideEffect ((fun - uu___94 + uu___96 -> if warn_unsafe @@ -1690,20 +1741,6 @@ let rec (specs_with_types : (Const (Bool true)))), - uu___93) in - let uu___93 - = - let uu___94 - = - let uu___95 - = - text - "Load OCaml module, compiling it if necessary" in - (FStar_Getopt.noshort, - "load", - (ReverseAccumulated - (PathStr - "module")), uu___95) in let uu___95 = @@ -1712,9 +1749,9 @@ let rec (specs_with_types : let uu___97 = text - "Load compiled module, fails hard if the module is not already compiled" in + "Load OCaml module, compiling it if necessary" in (FStar_Getopt.noshort, - "load_cmxs", + "load", (ReverseAccumulated (PathStr "module")), @@ -1726,12 +1763,12 @@ let rec (specs_with_types : let uu___99 = text - "Print types computed for data/val/let-bindings" in + "Load compiled module, fails hard if the module is not already compiled" in (FStar_Getopt.noshort, - "log_types", - (Const - (Bool - true)), + "load_cmxs", + (ReverseAccumulated + (PathStr + "module")), uu___99) in let uu___99 = @@ -1740,9 +1777,9 @@ let rec (specs_with_types : let uu___101 = text - "Log the Z3 queries in several queries-*.smt2 files, as we go" in + "Print types computed for data/val/let-bindings" in (FStar_Getopt.noshort, - "log_queries", + "log_types", (Const (Bool true)), @@ -1754,9 +1791,9 @@ let rec (specs_with_types : let uu___103 = text - "As --log_queries, but only save the failing queries. Each query is\n saved in its own file regardless of whether they were checked during the\n same invocation. The SMT2 file names begin with \"failedQueries\"" in + "Log the Z3 queries in several queries-*.smt2 files, as we go" in (FStar_Getopt.noshort, - "log_failing_queries", + "log_queries", (Const (Bool true)), @@ -1768,11 +1805,12 @@ let rec (specs_with_types : let uu___105 = text - "Number of unrolling of recursive functions to try at most (default 8)" in + "As --log_queries, but only save the failing queries. Each query is\n saved in its own file regardless of whether they were checked during the\n same invocation. The SMT2 file names begin with \"failedQueries\"" in (FStar_Getopt.noshort, - "max_fuel", - (IntStr - "non-negative integer"), + "log_failing_queries", + (Const + (Bool + true)), uu___105) in let uu___105 = @@ -1781,9 +1819,9 @@ let rec (specs_with_types : let uu___107 = text - "Number of unrolling of inductive datatypes to try at most (default 2)" in + "Number of unrolling of recursive functions to try at most (default 8)" in (FStar_Getopt.noshort, - "max_ifuel", + "max_fuel", (IntStr "non-negative integer"), uu___107) in @@ -1794,12 +1832,11 @@ let rec (specs_with_types : let uu___109 = text - "Trigger various specializations for compiling the F* compiler itself (not meant for user code)" in + "Number of unrolling of inductive datatypes to try at most (default 2)" in (FStar_Getopt.noshort, - "MLish", - (Const - (Bool - true)), + "max_ifuel", + (IntStr + "non-negative integer"), uu___109) in let uu___109 = @@ -1808,9 +1845,9 @@ let rec (specs_with_types : let uu___111 = text - "Ignore the default module search paths" in + "Trigger various specializations for compiling the F* compiler itself (not meant for user code)" in (FStar_Getopt.noshort, - "no_default_includes", + "MLish", (Const (Bool true)), @@ -1822,12 +1859,12 @@ let rec (specs_with_types : let uu___113 = text - "Deprecated: use --extract instead; Do not extract code from this module" in + "Ignore the default module search paths" in (FStar_Getopt.noshort, - "no_extract", - (Accumulated - (PathStr - "module name")), + "no_default_includes", + (Const + (Bool + true)), uu___113) in let uu___113 = @@ -1836,12 +1873,12 @@ let rec (specs_with_types : let uu___115 = text - "Suppress location information in the generated OCaml output (only relevant with --codegen OCaml)" in + "Deprecated: use --extract instead; Do not extract code from this module" in (FStar_Getopt.noshort, - "no_location_info", - (Const - (Bool - true)), + "no_extract", + (Accumulated + (PathStr + "module name")), uu___115) in let uu___115 = @@ -1850,9 +1887,9 @@ let rec (specs_with_types : let uu___117 = text - "Do not send any queries to the SMT solver, and fail on them instead" in + "Suppress location information in the generated OCaml output (only relevant with --codegen OCaml)" in (FStar_Getopt.noshort, - "no_smt", + "no_location_info", (Const (Bool true)), @@ -1864,9 +1901,9 @@ let rec (specs_with_types : let uu___119 = text - "Extract top-level pure terms after normalizing them. This can lead to very large code, but can result in more partial evaluation and compile-time specialization." in + "Do not send any queries to the SMT solver, and fail on them instead" in (FStar_Getopt.noshort, - "normalize_pure_terms_for_extraction", + "no_smt", (Const (Bool true)), @@ -1878,13 +1915,12 @@ let rec (specs_with_types : let uu___121 = text - "Place output in directory dir" in + "Extract top-level pure terms after normalizing them. This can lead to very large code, but can result in more partial evaluation and compile-time specialization." in (FStar_Getopt.noshort, - "odir", - (PostProcessed - (pp_validate_dir, - (PathStr - "dir"))), + "normalize_pure_terms_for_extraction", + (Const + (Bool + true)), uu___121) in let uu___121 = @@ -1893,11 +1929,13 @@ let rec (specs_with_types : let uu___123 = text - "Output the result of --dep into this file instead of to standard output." in + "Place output in directory dir" in (FStar_Getopt.noshort, - "output_deps_to", + "odir", + (PostProcessed + (pp_validate_dir, (PathStr - "file"), + "dir"))), uu___123) in let uu___123 = @@ -1906,9 +1944,9 @@ let rec (specs_with_types : let uu___125 = text - "Use a custom prims.fst file. Do not use if you do not know exactly what you're doing." in + "Output the result of --dep into this file instead of to standard output." in (FStar_Getopt.noshort, - "prims", + "output_deps_to", (PathStr "file"), uu___125) in @@ -1919,12 +1957,11 @@ let rec (specs_with_types : let uu___127 = text - "Print the types of bound variables" in + "Use a custom prims.fst file. Do not use if you do not know exactly what you're doing." in (FStar_Getopt.noshort, - "print_bound_var_types", - (Const - (Bool - true)), + "prims", + (PathStr + "file"), uu___127) in let uu___127 = @@ -1933,9 +1970,9 @@ let rec (specs_with_types : let uu___129 = text - "Print inferred predicate transformers for all computation types" in + "Print the types of bound variables" in (FStar_Getopt.noshort, - "print_effect_args", + "print_bound_var_types", (Const (Bool true)), @@ -1947,9 +1984,9 @@ let rec (specs_with_types : let uu___131 = text - "Print the errors generated by declarations marked with expect_failure, useful for debugging error locations" in + "Print inferred predicate transformers for all computation types" in (FStar_Getopt.noshort, - "print_expected_failures", + "print_effect_args", (Const (Bool true)), @@ -1961,9 +1998,9 @@ let rec (specs_with_types : let uu___133 = text - "Print full names of variables" in + "Print the errors generated by declarations marked with expect_failure, useful for debugging error locations" in (FStar_Getopt.noshort, - "print_full_names", + "print_expected_failures", (Const (Bool true)), @@ -1975,9 +2012,9 @@ let rec (specs_with_types : let uu___135 = text - "Print implicit arguments" in + "Print full names of variables" in (FStar_Getopt.noshort, - "print_implicits", + "print_full_names", (Const (Bool true)), @@ -1989,9 +2026,9 @@ let rec (specs_with_types : let uu___137 = text - "Print universes" in + "Print implicit arguments" in (FStar_Getopt.noshort, - "print_universes", + "print_implicits", (Const (Bool true)), @@ -2003,9 +2040,9 @@ let rec (specs_with_types : let uu___139 = text - "Print Z3 statistics for each SMT query (details such as relevant modules, facts, etc. for each proof)" in + "Print universes" in (FStar_Getopt.noshort, - "print_z3_statistics", + "print_universes", (Const (Bool true)), @@ -2017,9 +2054,9 @@ let rec (specs_with_types : let uu___141 = text - "Print full names (deprecated; use --print_full_names instead)" in + "Print Z3 statistics for each SMT query (details such as relevant modules, facts, etc. for each proof)" in (FStar_Getopt.noshort, - "prn", + "print_z3_statistics", (Const (Bool true)), @@ -2031,9 +2068,9 @@ let rec (specs_with_types : let uu___143 = text - "Proof recovery mode: before failing an SMT query, retry 3 times, increasing rlimits. If the query goes through after retrying, verification will succeed, but a warning will be emitted. This feature is useful to restore a project after some change to its libraries or F* upgrade. Importantly, then, this option cannot be used in a pragma (#set-options, etc)." in + "Print full names (deprecated; use --print_full_names instead)" in (FStar_Getopt.noshort, - "proof_recovery", + "prn", (Const (Bool true)), @@ -2044,76 +2081,90 @@ let rec (specs_with_types : = let uu___145 = + text + "Proof recovery mode: before failing an SMT query, retry 3 times, increasing rlimits. If the query goes through after retrying, verification will succeed, but a warning will be emitted. This feature is useful to restore a project after some change to its libraries or F* upgrade. Importantly, then, this option cannot be used in a pragma (#set-options, etc)." in + (FStar_Getopt.noshort, + "proof_recovery", + (Const + (Bool + true)), + uu___145) in + let uu___145 + = let uu___146 = - text - "Repeats SMT queries to check for robustness" in let uu___147 = let uu___148 = + text + "Repeats SMT queries to check for robustness" in let uu___149 = let uu___150 = - text - "--quake N/M repeats each query checks that it succeeds at least N out of M times, aborting early if possible" in let uu___151 = let uu___152 = text - "--quake N/M/k works as above, except it will unconditionally run M times" in + "--quake N/M repeats each query checks that it succeeds at least N out of M times, aborting early if possible" in let uu___153 = let uu___154 = text - "--quake N is an alias for --quake N/N" in + "--quake N/M/k works as above, except it will unconditionally run M times" in let uu___155 = let uu___156 = text + "--quake N is an alias for --quake N/N" in + let uu___157 + = + let uu___158 + = + text "--quake N/k is an alias for --quake N/N/k" in - [uu___156] in + [uu___158] in + uu___156 + :: + uu___157 in uu___154 :: uu___155 in uu___152 :: uu___153 in - uu___150 - :: - uu___151 in FStar_Errors_Msg.bulleted - uu___149 in - let uu___149 + uu___151 in + let uu___151 = text "Using --quake disables --retry. When quake testing, queries are not splitted for error reporting unless '--split_queries always' is given. Queries from the smt_sync tactic are not quake-tested." in FStar_Pprint.op_Hat_Hat + uu___150 + uu___151 in + FStar_Pprint.op_Hat_Hat uu___148 uu___149 in - FStar_Pprint.op_Hat_Hat - uu___146 - uu___147 in (FStar_Getopt.noshort, "quake", (PostProcessed ((fun - uu___146 + uu___148 -> - match uu___146 + match uu___148 with | String s -> - let uu___147 + let uu___149 = interp_quake_arg s in - (match uu___147 + (match uu___149 with | (min, @@ -2134,18 +2185,18 @@ let rec (specs_with_types : false); String s)) | - uu___147 + uu___149 -> FStar_Compiler_Effect.failwith "impos"), (SimpleStr "positive integer or pair of positive integers"))), - uu___145) in - let uu___145 + uu___147) in + let uu___147 = - let uu___146 + let uu___148 = - let uu___147 + let uu___149 = text "Print SMT query statistics" in @@ -2154,12 +2205,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___147) in - let uu___147 + uu___149) in + let uu___149 = - let uu___148 + let uu___150 = - let uu___149 + let uu___151 = text "Record a database of hints for efficient proof replay" in @@ -2168,12 +2219,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___149) in - let uu___149 + uu___151) in + let uu___151 = - let uu___150 + let uu___152 = - let uu___151 + let uu___153 = text "Record the state of options used to check each sigelt, useful for the `check_with` attribute and metaprogramming. Note that this implies a performance hit and increases the size of checked files." in @@ -2182,12 +2233,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___151) in - let uu___151 + uu___153) in + let uu___153 = - let uu___152 + let uu___154 = - let uu___153 + let uu___155 = text "Retry each SMT query N times and succeed on the first try. Using --retry disables --quake." in @@ -2195,9 +2246,9 @@ let rec (specs_with_types : "retry", (PostProcessed ((fun - uu___154 + uu___156 -> - match uu___154 + match uu___156 with | Int i -> @@ -2218,18 +2269,18 @@ let rec (specs_with_types : true); Bool true) | - uu___155 + uu___157 -> FStar_Compiler_Effect.failwith "impos"), (IntStr "positive integer"))), - uu___153) in - let uu___153 + uu___155) in + let uu___155 = - let uu___154 + let uu___156 = - let uu___155 + let uu___157 = text "Optimistically, attempt using the recorded hint for toplevel_name (a top-level name in the current module) when trying to verify some other term 'g'" in @@ -2237,12 +2288,12 @@ let rec (specs_with_types : "reuse_hint_for", (SimpleStr "toplevel_name"), - uu___155) in - let uu___155 + uu___157) in + let uu___157 = - let uu___156 + let uu___158 = - let uu___157 + let uu___159 = text "Report every use of an escape hatch, include assume, admit, etc." in @@ -2251,12 +2302,12 @@ let rec (specs_with_types : (EnumStr ["warn"; "error"]), - uu___157) in - let uu___157 + uu___159) in + let uu___159 = - let uu___158 + let uu___160 = - let uu___159 + let uu___161 = text "Disable all non-critical output" in @@ -2265,12 +2316,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___159) in - let uu___159 + uu___161) in + let uu___161 = - let uu___160 + let uu___162 = - let uu___161 + let uu___163 = text "Path to the Z3 SMT solver (we could eventually support other solvers)" in @@ -2278,211 +2329,197 @@ let rec (specs_with_types : "smt", (PathStr "path"), - uu___161) in - let uu___161 + uu___163) in + let uu___163 = - let uu___162 + let uu___164 = - let uu___163 + let uu___165 = text "Toggle a peephole optimization that eliminates redundant uses of boxing/unboxing in the SMT encoding (default 'false')" in (FStar_Getopt.noshort, "smtencoding.elim_box", BoolStr, - uu___163) in - let uu___163 - = - let uu___164 - = + uu___165) in let uu___165 = let uu___166 = - text - "Control the representation of non-linear arithmetic functions in the SMT encoding:" in let uu___167 = let uu___168 = + text + "Control the representation of non-linear arithmetic functions in the SMT encoding:" in let uu___169 = let uu___170 = - text - "if 'boxwrap' use 'Prims.op_Multiply, Prims.op_Division, Prims.op_Modulus'" in let uu___171 = let uu___172 = text - "if 'native' use '*, div, mod'" in + "if 'boxwrap' use 'Prims.op_Multiply, Prims.op_Division, Prims.op_Modulus'" in let uu___173 = let uu___174 = text + "if 'native' use '*, div, mod'" in + let uu___175 + = + let uu___176 + = + text "if 'wrapped' use '_mul, _div, _mod : Int*Int -> Int'" in - [uu___174] in - uu___172 + [uu___176] in + uu___174 :: - uu___173 in - uu___170 + uu___175 in + uu___172 :: - uu___171 in + uu___173 in FStar_Errors_Msg.bulleted - uu___169 in - let uu___169 + uu___171 in + let uu___171 = text "(default 'boxwrap')" in FStar_Pprint.op_Hat_Hat + uu___170 + uu___171 in + FStar_Pprint.op_Hat_Hat uu___168 uu___169 in - FStar_Pprint.op_Hat_Hat - uu___166 - uu___167 in (FStar_Getopt.noshort, "smtencoding.nl_arith_repr", (EnumStr ["native"; "wrapped"; "boxwrap"]), - uu___165) in - let uu___165 - = - let uu___166 - = + uu___167) in let uu___167 = let uu___168 = - text - "Toggle the representation of linear arithmetic functions in the SMT encoding:" in let uu___169 = let uu___170 = + text + "Toggle the representation of linear arithmetic functions in the SMT encoding:" in let uu___171 = let uu___172 = - text - "if 'boxwrap', use 'Prims.op_Addition, Prims.op_Subtraction, Prims.op_Minus'" in let uu___173 = let uu___174 = text + "if 'boxwrap', use 'Prims.op_Addition, Prims.op_Subtraction, Prims.op_Minus'" in + let uu___175 + = + let uu___176 + = + text "if 'native', use '+, -, -'" in - [uu___174] in - uu___172 + [uu___176] in + uu___174 :: - uu___173 in + uu___175 in FStar_Errors_Msg.bulleted - uu___171 in - let uu___171 + uu___173 in + let uu___173 = text "(default 'boxwrap')" in FStar_Pprint.op_Hat_Hat + uu___172 + uu___173 in + FStar_Pprint.op_Hat_Hat uu___170 uu___171 in - FStar_Pprint.op_Hat_Hat - uu___168 - uu___169 in (FStar_Getopt.noshort, "smtencoding.l_arith_repr", (EnumStr ["native"; "boxwrap"]), - uu___167) in - let uu___167 + uu___169) in + let uu___169 = - let uu___168 + let uu___170 = - let uu___169 + let uu___171 = text "Include an axiom in the SMT encoding to introduce proof-irrelevance from a constructive proof" in (FStar_Getopt.noshort, "smtencoding.valid_intro", BoolStr, - uu___169) in - let uu___169 + uu___171) in + let uu___171 = - let uu___170 + let uu___172 = - let uu___171 + let uu___173 = text "Include an axiom in the SMT encoding to eliminate proof-irrelevance into the existence of a proof witness" in (FStar_Getopt.noshort, "smtencoding.valid_elim", BoolStr, - uu___171) in - let uu___171 - = - let uu___172 - = + uu___173) in let uu___173 = let uu___174 = - text - "Split SMT verification conditions into several separate queries, one per goal. Helps with localizing errors." in let uu___175 = let uu___176 = + text + "Split SMT verification conditions into several separate queries, one per goal. Helps with localizing errors." in let uu___177 = - text - "Use 'no' to disable (this may reduce the quality of error messages)." in let uu___178 = let uu___179 = text - "Use 'on_failure' to split queries and retry when discharging fails (the default)" in + "Use 'no' to disable (this may reduce the quality of error messages)." in let uu___180 = let uu___181 = text + "Use 'on_failure' to split queries and retry when discharging fails (the default)" in + let uu___182 + = + let uu___183 + = + text "Use 'yes' to always split." in - [uu___181] in + [uu___183] in + uu___181 + :: + uu___182 in uu___179 :: uu___180 in - uu___177 - :: - uu___178 in FStar_Errors_Msg.bulleted - uu___176 in + uu___178 in FStar_Pprint.op_Hat_Hat - uu___174 - uu___175 in + uu___176 + uu___177 in (FStar_Getopt.noshort, "split_queries", (EnumStr ["no"; "on_failure"; "always"]), - uu___173) in - let uu___173 - = - let uu___174 - = - let uu___175 - = - text - "Do not use the lexical scope of tactics to improve binder names" in - (FStar_Getopt.noshort, - "tactic_raw_binders", - (Const - (Bool - true)), uu___175) in let uu___175 = @@ -2491,9 +2528,9 @@ let rec (specs_with_types : let uu___177 = text - "Do not recover from metaprogramming errors, and abort if one occurs" in + "Do not use the lexical scope of tactics to improve binder names" in (FStar_Getopt.noshort, - "tactics_failhard", + "tactic_raw_binders", (Const (Bool true)), @@ -2505,9 +2542,9 @@ let rec (specs_with_types : let uu___179 = text - "Print some rough information on tactics, such as the time they take to run" in + "Do not recover from metaprogramming errors, and abort if one occurs" in (FStar_Getopt.noshort, - "tactics_info", + "tactics_failhard", (Const (Bool true)), @@ -2519,9 +2556,9 @@ let rec (specs_with_types : let uu___181 = text - "Print a depth-indexed trace of tactic execution (Warning: very verbose)" in + "Print some rough information on tactics, such as the time they take to run" in (FStar_Getopt.noshort, - "tactic_trace", + "tactics_info", (Const (Bool true)), @@ -2533,11 +2570,12 @@ let rec (specs_with_types : let uu___183 = text - "Trace tactics up to a certain binding depth" in + "Print a depth-indexed trace of tactic execution (Warning: very verbose)" in (FStar_Getopt.noshort, - "tactic_trace_d", - (IntStr - "positive_integer"), + "tactic_trace", + (Const + (Bool + true)), uu___183) in let uu___183 = @@ -2546,12 +2584,11 @@ let rec (specs_with_types : let uu___185 = text - "Use NBE to evaluate metaprograms (experimental)" in + "Trace tactics up to a certain binding depth" in (FStar_Getopt.noshort, - "__tactics_nbe", - (Const - (Bool - true)), + "tactic_trace_d", + (IntStr + "positive_integer"), uu___185) in let uu___185 = @@ -2560,10 +2597,12 @@ let rec (specs_with_types : let uu___187 = text - "Attempt to normalize definitions marked as tcnorm (default 'true')" in + "Use NBE to evaluate metaprograms (experimental)" in (FStar_Getopt.noshort, - "tcnorm", - BoolStr, + "__tactics_nbe", + (Const + (Bool + true)), uu___187) in let uu___187 = @@ -2572,12 +2611,10 @@ let rec (specs_with_types : let uu___189 = text - "Print the time it takes to verify each top-level definition. This is just an alias for an invocation of the profiler, so it may not work well if combined with --profile. In particular, it implies --profile_group_by_decl." in + "Attempt to normalize definitions marked as tcnorm (default 'true')" in (FStar_Getopt.noshort, - "timing", - (Const - (Bool - true)), + "tcnorm", + BoolStr, uu___189) in let uu___189 = @@ -2586,9 +2623,9 @@ let rec (specs_with_types : let uu___191 = text - "Attach stack traces on errors" in + "Print the time it takes to verify each top-level definition. This is just an alias for an invocation of the profiler, so it may not work well if combined with --profile. In particular, it implies --profile_group_by_decl." in (FStar_Getopt.noshort, - "trace_error", + "timing", (Const (Bool true)), @@ -2600,9 +2637,9 @@ let rec (specs_with_types : let uu___193 = text - "Emit output formatted for debugging" in + "Attach stack traces on errors" in (FStar_Getopt.noshort, - "ugly", + "trace_error", (Const (Bool true)), @@ -2614,9 +2651,9 @@ let rec (specs_with_types : let uu___195 = text - "Let the SMT solver unfold inductive types to arbitrary depths (may affect verifier performance)" in + "Emit output formatted for debugging" in (FStar_Getopt.noshort, - "unthrottle_inductives", + "ugly", (Const (Bool true)), @@ -2628,9 +2665,9 @@ let rec (specs_with_types : let uu___197 = text - "Allow tactics to run external processes. WARNING: checking an untrusted F* file while using this option can have disastrous effects." in + "Let the SMT solver unfold inductive types to arbitrary depths (may affect verifier performance)" in (FStar_Getopt.noshort, - "unsafe_tactic_exec", + "unthrottle_inductives", (Const (Bool true)), @@ -2642,9 +2679,9 @@ let rec (specs_with_types : let uu___199 = text - "Use equality constraints when comparing higher-order types (Temporary)" in + "Allow tactics to run external processes. WARNING: checking an untrusted F* file while using this option can have disastrous effects." in (FStar_Getopt.noshort, - "use_eq_at_higher_order", + "unsafe_tactic_exec", (Const (Bool true)), @@ -2656,9 +2693,9 @@ let rec (specs_with_types : let uu___201 = text - "Use a previously recorded hints database for proof replay" in + "Use equality constraints when comparing higher-order types (Temporary)" in (FStar_Getopt.noshort, - "use_hints", + "use_eq_at_higher_order", (Const (Bool true)), @@ -2670,9 +2707,9 @@ let rec (specs_with_types : let uu___203 = text - "Admit queries if their hash matches the hash recorded in the hints database" in + "Use a previously recorded hints database for proof replay" in (FStar_Getopt.noshort, - "use_hint_hashes", + "use_hints", (Const (Bool true)), @@ -2684,11 +2721,12 @@ let rec (specs_with_types : let uu___205 = text - "Use compiled tactics from path" in + "Admit queries if their hash matches the hash recorded in the hints database" in (FStar_Getopt.noshort, - "use_native_tactics", - (PathStr - "path"), + "use_hint_hashes", + (Const + (Bool + true)), uu___205) in let uu___205 = @@ -2697,12 +2735,11 @@ let rec (specs_with_types : let uu___207 = text - "Do not run plugins natively and interpret them as usual instead" in + "Use compiled tactics from path" in (FStar_Getopt.noshort, - "no_plugins", - (Const - (Bool - true)), + "use_native_tactics", + (PathStr + "path"), uu___207) in let uu___207 = @@ -2711,9 +2748,9 @@ let rec (specs_with_types : let uu___209 = text - "Do not run the tactic engine before discharging a VC" in + "Do not run plugins natively and interpret them as usual instead" in (FStar_Getopt.noshort, - "no_tactics", + "no_plugins", (Const (Bool true)), @@ -2725,18 +2762,32 @@ let rec (specs_with_types : let uu___211 = text + "Do not run the tactic engine before discharging a VC" in + (FStar_Getopt.noshort, + "no_tactics", + (Const + (Bool + true)), + uu___211) in + let uu___211 + = + let uu___212 + = + let uu___213 + = + text "Prunes the context to include only the facts from the given namespace or fact id. Facts can be include or excluded using the [+|-] qualifier. For example --using_facts_from '* -FStar.Reflection +FStar.Compiler.List -FStar.Compiler.List.Tot' will remove all facts from FStar.Compiler.List.Tot.*, retain all remaining facts from FStar.Compiler.List.*, remove all facts from FStar.Reflection.*, and retain all the rest. Note, the '+' is optional: --using_facts_from 'FStar.Compiler.List' is equivalent to --using_facts_from '+FStar.Compiler.List'. Multiple uses of this option accumulate, e.g., --using_facts_from A --using_facts_from B is interpreted as --using_facts_from A^B." in (FStar_Getopt.noshort, "using_facts_from", (ReverseAccumulated (SimpleStr "One or more space-separated occurrences of '[+|-]( * | namespace | fact id)'")), - uu___211) in - let uu___211 + uu___213) in + let uu___213 = - let uu___212 + let uu___214 = - let uu___213 + let uu___215 = text "This does nothing and will be removed" in @@ -2745,12 +2796,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___213) in - let uu___213 + uu___215) in + let uu___215 = - let uu___214 + let uu___216 = - let uu___215 + let uu___217 = text "Display version number" in @@ -2758,7 +2809,7 @@ let rec (specs_with_types : "version", (WithSideEffect ((fun - uu___216 + uu___218 -> display_version (); @@ -2767,12 +2818,12 @@ let rec (specs_with_types : (Const (Bool true)))), - uu___215) in - let uu___215 + uu___217) in + let uu___217 = - let uu___216 + let uu___218 = - let uu___217 + let uu___219 = text "Warn when (a -> b) is desugared to (a -> Tot b)" in @@ -2781,12 +2832,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___217) in - let uu___217 + uu___219) in + let uu___219 = - let uu___218 + let uu___220 = - let uu___219 + let uu___221 = text "Z3 command line options" in @@ -2795,12 +2846,12 @@ let rec (specs_with_types : (ReverseAccumulated (SimpleStr "option")), - uu___219) in - let uu___219 + uu___221) in + let uu___221 = - let uu___220 + let uu___222 = - let uu___221 + let uu___223 = text "Z3 options in smt2 format" in @@ -2809,12 +2860,12 @@ let rec (specs_with_types : (ReverseAccumulated (SimpleStr "option")), - uu___221) in - let uu___221 + uu___223) in + let uu___223 = - let uu___222 + let uu___224 = - let uu___223 + let uu___225 = text "Restart Z3 after each query; useful for ensuring proof robustness" in @@ -2823,12 +2874,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___223) in - let uu___223 + uu___225) in + let uu___225 = - let uu___224 + let uu___226 = - let uu___225 + let uu___227 = text "Set the Z3 per-query resource limit (default 5 units, taking roughtly 5s)" in @@ -2836,12 +2887,12 @@ let rec (specs_with_types : "z3rlimit", (IntStr "positive_integer"), - uu___225) in - let uu___225 + uu___227) in + let uu___227 = - let uu___226 + let uu___228 = - let uu___227 + let uu___229 = text "Set the Z3 per-query resource limit multiplier. This is useful when, say, regenerating hints and you want to be more lax. (default 1)" in @@ -2849,12 +2900,12 @@ let rec (specs_with_types : "z3rlimit_factor", (IntStr "positive_integer"), - uu___227) in - let uu___227 + uu___229) in + let uu___229 = - let uu___228 + let uu___230 = - let uu___229 + let uu___231 = text "Set the Z3 random seed (default 0)" in @@ -2862,12 +2913,12 @@ let rec (specs_with_types : "z3seed", (IntStr "positive_integer"), - uu___229) in - let uu___229 + uu___231) in + let uu___231 = - let uu___230 + let uu___232 = - let uu___231 + let uu___233 = text "Set the version of Z3 that is to be used. Default: 4.8.5" in @@ -2875,12 +2926,12 @@ let rec (specs_with_types : "z3version", (SimpleStr "version"), - uu___231) in - let uu___231 + uu___233) in + let uu___233 = - let uu___232 + let uu___234 = - let uu___233 + let uu___235 = text "Don't check positivity of inductive types" in @@ -2888,7 +2939,7 @@ let rec (specs_with_types : "__no_positivity", (WithSideEffect ((fun - uu___234 + uu___236 -> if warn_unsafe @@ -2899,75 +2950,63 @@ let rec (specs_with_types : (Const (Bool true)))), - uu___233) in - let uu___233 - = - let uu___234 - = + uu___235) in let uu___235 = let uu___236 = - text - "The [-warn_error] option follows the OCaml syntax, namely:" in let uu___237 = let uu___238 = + text + "The [-warn_error] option follows the OCaml syntax, namely:" in let uu___239 = - text - "[r] is a range of warnings (either a number [n], or a range [n..n])" in let uu___240 = let uu___241 = text - "[-r] silences range [r]" in + "[r] is a range of warnings (either a number [n], or a range [n..n])" in let uu___242 = let uu___243 = text - "[+r] enables range [r] as warnings (NOTE: \"enabling\" an error will downgrade it to a warning)" in + "[-r] silences range [r]" in let uu___244 = let uu___245 = text + "[+r] enables range [r] as warnings (NOTE: \"enabling\" an error will downgrade it to a warning)" in + let uu___246 + = + let uu___247 + = + text "[@r] makes range [r] fatal." in - [uu___245] in + [uu___247] in + uu___245 + :: + uu___246 in uu___243 :: uu___244 in uu___241 :: uu___242 in - uu___239 - :: - uu___240 in FStar_Errors_Msg.bulleted - uu___238 in + uu___240 in FStar_Pprint.op_Hat_Hat - uu___236 - uu___237 in + uu___238 + uu___239 in (FStar_Getopt.noshort, "warn_error", (ReverseAccumulated (SimpleStr "")), - uu___235) in - let uu___235 - = - let uu___236 - = - let uu___237 - = - text - "Use normalization by evaluation as the default normalization strategy (default 'false')" in - (FStar_Getopt.noshort, - "use_nbe", - BoolStr, uu___237) in let uu___237 = @@ -2976,9 +3015,9 @@ let rec (specs_with_types : let uu___239 = text - "Use normalization by evaluation for normalizing terms before extraction (default 'false')" in + "Use normalization by evaluation as the default normalization strategy (default 'false')" in (FStar_Getopt.noshort, - "use_nbe_for_extraction", + "use_nbe", BoolStr, uu___239) in let uu___239 @@ -2988,9 +3027,9 @@ let rec (specs_with_types : let uu___241 = text - "Enforce trivial preconditions for unannotated effectful functions (default 'true')" in + "Use normalization by evaluation for normalizing terms before extraction (default 'false')" in (FStar_Getopt.noshort, - "trivial_pre_for_unannotated_effectful_fns", + "use_nbe_for_extraction", BoolStr, uu___241) in let uu___241 @@ -3000,12 +3039,24 @@ let rec (specs_with_types : let uu___243 = text + "Enforce trivial preconditions for unannotated effectful functions (default 'true')" in + (FStar_Getopt.noshort, + "trivial_pre_for_unannotated_effectful_fns", + BoolStr, + uu___243) in + let uu___243 + = + let uu___244 + = + let uu___245 + = + text "Debug messages for embeddings/unembeddings of natively compiled terms" in (FStar_Getopt.noshort, "__debug_embedding", (WithSideEffect ((fun - uu___244 + uu___246 -> FStar_Compiler_Effect.op_Colon_Equals debug_embedding @@ -3013,12 +3064,12 @@ let rec (specs_with_types : (Const (Bool true)))), - uu___243) in - let uu___243 + uu___245) in + let uu___245 = - let uu___244 + let uu___246 = - let uu___245 + let uu___247 = text "Eagerly embed and unembed terms to primitive operations and plugins: not recommended except for benchmarking" in @@ -3026,7 +3077,7 @@ let rec (specs_with_types : "eager_embedding", (WithSideEffect ((fun - uu___246 + uu___248 -> FStar_Compiler_Effect.op_Colon_Equals eager_embedding @@ -3034,12 +3085,12 @@ let rec (specs_with_types : (Const (Bool true)))), - uu___245) in - let uu___245 + uu___247) in + let uu___247 = - let uu___246 + let uu___248 = - let uu___247 + let uu___249 = text "Emit profiles grouped by declaration rather than by module" in @@ -3048,12 +3099,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___247) in - let uu___247 + uu___249) in + let uu___249 = - let uu___248 + let uu___250 = - let uu___249 + let uu___251 = text "Specific source locations in the compiler are instrumented with profiling counters. Pass `--profile_component FStar.TypeChecker` to enable all counters in the FStar.TypeChecker namespace. This option is a module or namespace selector, like many other options (e.g., `--extract`)" in @@ -3062,12 +3113,12 @@ let rec (specs_with_types : (Accumulated (SimpleStr "One or more space-separated occurrences of '[+|-]( * | namespace | module | identifier)'")), - uu___249) in - let uu___249 + uu___251) in + let uu___251 = - let uu___250 + let uu___252 = - let uu___251 + let uu___253 = text "Profiling can be enabled when the compiler is processing a given set of source modules. Pass `--profile FStar.Pervasives` to enable profiling when the compiler is processing any module in FStar.Pervasives. This option is a module or namespace selector, like many other options (e.g., `--extract`)" in @@ -3076,12 +3127,12 @@ let rec (specs_with_types : (Accumulated (SimpleStr "One or more space-separated occurrences of '[+|-]( * | namespace | module)'")), - uu___251) in - let uu___251 + uu___253) in + let uu___253 = - let uu___252 + let uu___254 = - let uu___253 + let uu___255 = text "Display this information" in @@ -3089,26 +3140,26 @@ let rec (specs_with_types : "help", (WithSideEffect ((fun - uu___254 + uu___256 -> ( - let uu___256 + let uu___258 = specs warn_unsafe in display_usage_aux - uu___256); + uu___258); FStar_Compiler_Effect.exit Prims.int_zero), (Const (Bool true)))), - uu___253) in - let uu___253 + uu___255) in + let uu___255 = - let uu___254 + let uu___256 = - let uu___255 + let uu___257 = text "List all debug keys and exit" in @@ -3116,7 +3167,7 @@ let rec (specs_with_types : "list_debug_keys", (WithSideEffect ((fun - uu___256 + uu___258 -> display_debug_keys (); @@ -3125,8 +3176,11 @@ let rec (specs_with_types : (Const (Bool true)))), - uu___255) in - [uu___254] in + uu___257) in + [uu___256] in + uu___254 + :: + uu___255 in uu___252 :: uu___253 in @@ -3473,6 +3527,7 @@ let (settable : Prims.string -> Prims.bool) = | "compat_pre_typed_indexed_effects" -> true | "disallow_unification_guards" -> true | "debug" -> true + | "debug_all" -> true | "debug_all_modules" -> true | "defensive" -> true | "detail_errors" -> true @@ -3569,7 +3624,7 @@ let (settable_specs : (fun uu___ -> match uu___ with | ((uu___1, x, uu___2), uu___3) -> settable x) all_specs -let (uu___645 : +let (uu___658 : (((unit -> FStar_Getopt.parse_cmdline_res) -> unit) * (unit -> FStar_Getopt.parse_cmdline_res))) = @@ -3586,11 +3641,11 @@ let (uu___645 : (set1, call) let (set_error_flags_callback_aux : (unit -> FStar_Getopt.parse_cmdline_res) -> unit) = - match uu___645 with + match uu___658 with | (set_error_flags_callback_aux1, set_error_flags) -> set_error_flags_callback_aux1 let (set_error_flags : unit -> FStar_Getopt.parse_cmdline_res) = - match uu___645 with + match uu___658 with | (set_error_flags_callback_aux1, set_error_flags1) -> set_error_flags1 let (set_error_flags_callback : (unit -> FStar_Getopt.parse_cmdline_res) -> unit) = @@ -4170,6 +4225,8 @@ let (trivial_pre_for_unannotated_effectful_fns : unit -> Prims.bool) = fun uu___ -> get_trivial_pre_for_unannotated_effectful_fns () let (debug_keys : unit -> Prims.string Prims.list) = fun uu___ -> lookup_opt "debug" as_comma_string_list +let (debug_all : unit -> Prims.bool) = + fun uu___ -> lookup_opt "debug_all" as_bool let (debug_all_modules : unit -> Prims.bool) = fun uu___ -> lookup_opt "debug_all_modules" as_bool let with_saved_options : 'a . (unit -> 'a) -> 'a = From 1c036e9680d5205eb10b74250e98c67f7ea69b35 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 17 May 2024 18:09:24 -0700 Subject: [PATCH 214/239] Introduce FStar.RefinementExtensionality --- ulib/FStar.RefinementExtensionality.fst | 33 ++++++++++++++++++++++++ ulib/FStar.RefinementExtensionality.fsti | 5 ++++ 2 files changed, 38 insertions(+) create mode 100644 ulib/FStar.RefinementExtensionality.fst create mode 100644 ulib/FStar.RefinementExtensionality.fsti diff --git a/ulib/FStar.RefinementExtensionality.fst b/ulib/FStar.RefinementExtensionality.fst new file mode 100644 index 00000000000..6ac69db4317 --- /dev/null +++ b/ulib/FStar.RefinementExtensionality.fst @@ -0,0 +1,33 @@ +module FStar.RefinementExtensionality + +open FStar.FunctionalExtensionality +open FStar.PredicateExtensionality + +let refext0 (t:Type) (r1 : t -> prop) (r2 : t -> prop) : + Lemma (requires (r1 == r2)) + (ensures (x:t{r1 x} == x:t{r2 x})) = () + +let refext_on_domain (t:Type) (r1 : t -> prop) (r2 : t -> prop) : + Lemma (requires (forall x. r1 x <==> r2 x)) + (ensures (x:t{on t r1 x} == x:t{on t r2 x})) = + PredicateExtensionality.predicateExtensionality _ r1 r2; + refext0 t (on t r1) (on t r2) + +let refext (t:Type) (r1 : t -> prop) (r2 : t -> prop) : + Lemma (requires (forall x. r1 x <==> r2 x)) + (ensures (x:t{r1 x} == x:t{r2 x})) = + assert (x:t{on t r1 x} == x:t{r1 x}); + assert (x:t{on t r2 x} == x:t{r2 x}); + refext_on_domain t r1 r2; + () + +(* Small test. Use names to avoid hash-consing mismatches. *) +let ref1 (x:int) : prop = b2t (x >= 0) +let ref2 (x:int) : prop = x >= 0 \/ x >= 1 + +let ty1 = x:int{ref1 x} +let ty2 = x:int{ref2 x} + +let _ = + refext int ref1 ref2; + assert (ty1 == ty2) diff --git a/ulib/FStar.RefinementExtensionality.fsti b/ulib/FStar.RefinementExtensionality.fsti new file mode 100644 index 00000000000..5fb90dd1fee --- /dev/null +++ b/ulib/FStar.RefinementExtensionality.fsti @@ -0,0 +1,5 @@ +module FStar.RefinementExtensionality + +val refext (t:Type) (r1 : t -> prop) (r2 : t -> prop) : + Lemma (requires (forall x. r1 x <==> r2 x)) + (ensures (x:t{r1 x} == x:t{r2 x})) From a76e27e6a708a04b61a39759f467b504836391a8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Sun, 19 May 2024 12:28:01 -0700 Subject: [PATCH 215/239] snap --- ocaml/fstar-lib/generated/FStar_RefinementExtensionality.ml | 5 +++++ 1 file changed, 5 insertions(+) create mode 100644 ocaml/fstar-lib/generated/FStar_RefinementExtensionality.ml diff --git a/ocaml/fstar-lib/generated/FStar_RefinementExtensionality.ml b/ocaml/fstar-lib/generated/FStar_RefinementExtensionality.ml new file mode 100644 index 00000000000..868c3b1fd91 --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_RefinementExtensionality.ml @@ -0,0 +1,5 @@ +open Prims +type 'x ref1 = unit +type 'x ref2 = unit +type ty1 = Prims.int +type ty2 = Prims.int \ No newline at end of file From c6e8e180c0d10ed694c4d942596a9df2bc7ffe5a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 29 Sep 2023 11:17:33 -0700 Subject: [PATCH 216/239] Tc: pretty printing basic_type_error --- src/typechecker/FStar.TypeChecker.Err.fst | 13 +++++++++++-- src/typechecker/FStar.TypeChecker.Rel.fst | 4 ++-- src/typechecker/FStar.TypeChecker.TcTerm.fst | 2 +- src/typechecker/FStar.TypeChecker.Util.fst | 2 +- 4 files changed, 15 insertions(+), 6 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.Err.fst b/src/typechecker/FStar.TypeChecker.Err.fst index 6f3cbf24e23..7ed7da4421d 100644 --- a/src/typechecker/FStar.TypeChecker.Err.fst +++ b/src/typechecker/FStar.TypeChecker.Err.fst @@ -222,9 +222,18 @@ let expected_pattern_of_type env t1 e t2 = let basic_type_error env eopt t1 t2 = let s1, s2 = err_msg_type_strings env t1 t2 in + let open FStar.Errors.Msg in let msg = match eopt with - | None -> format2 "Expected type \"%s\"; got type \"%s\"" s1 s2 - | Some e -> format3 "Expected type \"%s\"; but \"%s\" has type \"%s\"" s1 (N.term_to_string env e) s2 in + | None -> [ + prefix 4 1 (text "Expected type") (N.term_to_doc env t1) ^/^ + prefix 4 1 (text "got type") (N.term_to_doc env t2); + ] + | Some e -> [ + prefix 4 1 (text "Expected type") (N.term_to_doc env t1) ^/^ + prefix 4 1 (text "but") (N.term_to_doc env e) ^/^ + prefix 4 1 (text "has type") (N.term_to_doc env t2); + ] + in (Errors.Error_TypeError, msg) let occurs_check = diff --git a/src/typechecker/FStar.TypeChecker.Rel.fst b/src/typechecker/FStar.TypeChecker.Rel.fst index 7a1b35c5ef6..ca9c47bbe8c 100644 --- a/src/typechecker/FStar.TypeChecker.Rel.fst +++ b/src/typechecker/FStar.TypeChecker.Rel.fst @@ -4833,7 +4833,7 @@ let try_teq smt_ok env t1 t2 : option guard_t = let teq env t1 t2 : guard_t = match try_teq true env t1 t2 with | None -> - FStar.Errors.log_issue + FStar.Errors.log_issue_doc (Env.get_range env) (Err.basic_type_error env None t2 t1); trivial_guard @@ -4862,7 +4862,7 @@ let get_teq_predicate env t1 t2 = | Some g -> Some (abstract_guard (S.mk_binder x) g) let subtype_fail env e t1 t2 = - Errors.log_issue (Env.get_range env) (Err.basic_type_error env (Some e) t2 t1) + Errors.log_issue_doc (Env.get_range env) (Err.basic_type_error env (Some e) t2 t1) let sub_or_eq_comp env (use_eq:bool) c1 c2 = Profiling.profile (fun () -> diff --git a/src/typechecker/FStar.TypeChecker.TcTerm.fst b/src/typechecker/FStar.TypeChecker.TcTerm.fst index 54443019a61..4ac7c6f97e5 100644 --- a/src/typechecker/FStar.TypeChecker.TcTerm.fst +++ b/src/typechecker/FStar.TypeChecker.TcTerm.fst @@ -2221,7 +2221,7 @@ and tc_abs_check_binders env bs bs_expected use_eq then Rel.teq env t expected_t |> label_guard else match Rel.get_subtyping_prop env expected_t t with | None -> - raise_error (Err.basic_type_error env None expected_t t) (Env.get_range env) + raise_error_doc (Err.basic_type_error env None expected_t t) (Env.get_range env) | Some g_env -> label_guard g_env in t, Env.conj_guard g1_env g2_env in diff --git a/src/typechecker/FStar.TypeChecker.Util.fst b/src/typechecker/FStar.TypeChecker.Util.fst index 4a7c4a3eaa7..b27278d102b 100644 --- a/src/typechecker/FStar.TypeChecker.Util.fst +++ b/src/typechecker/FStar.TypeChecker.Util.fst @@ -2648,7 +2648,7 @@ let weaken_result_typ env (e:term) (lc:lcomp) (t:typ) (use_eq:bool) : term * lco * AR: 11/18: should this always fail hard? *) if env.failhard - then raise_error (Err.basic_type_error env (Some e) t lc.res_typ) e.pos + then raise_error_doc (Err.basic_type_error env (Some e) t lc.res_typ) e.pos else ( subtype_fail env e lc.res_typ t; //log a sub-typing error e, {lc with res_typ=t}, Env.trivial_guard //and keep going to type-check the result of the program From 82577362b3383697aa3f42f1cdd3d8d5324d9f6e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 17 May 2024 10:53:03 -0700 Subject: [PATCH 217/239] Tactics: add a ForceSMT guard_policy Forces the guard immediately, raising an exception if it cannot be discharged, but allows for use of SMT. --- src/tactics/FStar.Tactics.Types.fsti | 1 + src/tactics/FStar.Tactics.V2.Basic.fst | 10 ++++++++++ ulib/FStar.Stubs.Tactics.Types.fsti | 3 ++- 3 files changed, 13 insertions(+), 1 deletion(-) diff --git a/src/tactics/FStar.Tactics.Types.fsti b/src/tactics/FStar.Tactics.Types.fsti index 2a1acc0b8e3..07b6aeb16f7 100644 --- a/src/tactics/FStar.Tactics.Types.fsti +++ b/src/tactics/FStar.Tactics.Types.fsti @@ -49,6 +49,7 @@ type guard_policy = | SMT | SMTSync | Force + | ForceSMT | Drop // unsound type proofstate = { diff --git a/src/tactics/FStar.Tactics.V2.Basic.fst b/src/tactics/FStar.Tactics.V2.Basic.fst index 453c35f1e2b..8b1af6b430d 100644 --- a/src/tactics/FStar.Tactics.V2.Basic.fst +++ b/src/tactics/FStar.Tactics.V2.Basic.fst @@ -264,6 +264,16 @@ let proc_guard_formula | _ -> mlog (fun () -> BU.print1 "guard = %s\n" (show f)) (fun () -> fail1 "Forcing the guard failed (%s)" reason)) + | ForceSMT -> + mlog (fun () -> BU.print2 "Forcing guard WITH SMT (%s:%s)\n" reason (show f)) (fun () -> + let g = { Env.trivial_guard with guard_f = NonTrivial f } in + try if not (Env.is_trivial <| Rel.discharge_guard e g) + then fail1 "Forcing the guard failed (%s)" reason + else return () + with + | _ -> mlog (fun () -> BU.print1 "guard = %s\n" (show f)) (fun () -> + fail1 "Forcing the guard failed (%s)" reason)) + let proc_guard' (simplify:bool) (reason:string) (e : env) (g : guard_t) (sc_opt:option should_check_uvar) (rng:Range.range) : tac unit = mlog (fun () -> BU.print2 "Processing guard (%s:%s)\n" reason (Rel.guard_to_string e g)) (fun () -> diff --git a/ulib/FStar.Stubs.Tactics.Types.fsti b/ulib/FStar.Stubs.Tactics.Types.fsti index 5615e2bbbcd..d3898c04d25 100644 --- a/ulib/FStar.Stubs.Tactics.Types.fsti +++ b/ulib/FStar.Stubs.Tactics.Types.fsti @@ -57,7 +57,8 @@ type guard_policy = | Goal // Add guards as (normal) goals | SMT // Add guards as SMT goals | SMTSync // Send guards to SMT immediately, will *log* errors (not raise) if anything fails - | Force // Force guards without SMT + | Force // Force guards without SMT, immediately. Raises an exception on failure. + | ForceSMT // Force guards with SMT, immediately. Raises an exception on failure. | Drop // Drop guards, clearly unsound! careful! (* Typing reflection *) From 74e4dedb2f1f34b86c0f1786b4a65faa4484452b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 17 May 2024 14:56:42 -0700 Subject: [PATCH 218/239] Tactics: nit on debug message --- src/tactics/FStar.Tactics.V2.Basic.fst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/tactics/FStar.Tactics.V2.Basic.fst b/src/tactics/FStar.Tactics.V2.Basic.fst index 8b1af6b430d..0dc2521d213 100644 --- a/src/tactics/FStar.Tactics.V2.Basic.fst +++ b/src/tactics/FStar.Tactics.V2.Basic.fst @@ -2308,10 +2308,10 @@ let refl_check_relation (rel:relation) (smt_ok:bool) (unfolding_ok:bool) (g:env) else Core.check_term_equality in match f smt_ok unfolding_ok g t0 t1 with | Inl None -> - dbg_refl g (fun _ -> "refl_check_relation: succeeded (no guard)"); + dbg_refl g (fun _ -> "refl_check_relation: succeeded (no guard)\n"); ((), []) | Inl (Some guard_f) -> - dbg_refl g (fun _ -> "refl_check_relation: succeeded"); + dbg_refl g (fun _ -> "refl_check_relation: succeeded\n"); ((), [(g, guard_f)]) | Inr err -> dbg_refl g (fun _ -> BU.format1 "refl_check_relation failed: %s\n" (Core.print_error err)); From ea6f6afcde49b70790d3d8681fb5d2a00136bf44 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 17 May 2024 16:14:55 -0700 Subject: [PATCH 219/239] Tactics: minor refactor --- ulib/FStar.Tactics.Typeclasses.fst | 7 ------- ulib/FStar.Tactics.V2.SyntaxHelpers.fst | 8 ++++++++ 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/ulib/FStar.Tactics.Typeclasses.fst b/ulib/FStar.Tactics.Typeclasses.fst index 69bb508a2ed..326a2a194a0 100644 --- a/ulib/FStar.Tactics.Typeclasses.fst +++ b/ulib/FStar.Tactics.Typeclasses.fst @@ -89,13 +89,6 @@ let rec head_of (t:term) : Tac (option fv) = | Tv_App h _ -> head_of h | v -> None -let hua (t:term) : Tac (option (fv & universes & list argv)) = - let hd, args = collect_app t in - match inspect hd with - | Tv_FVar fv -> Some (fv, [], args) - | Tv_UInst fv us -> Some (fv, us, args) - | _ -> None - let rec res_typ (t:term) : Tac term = match inspect t with | Tv_Arrow _ c -> ( diff --git a/ulib/FStar.Tactics.V2.SyntaxHelpers.fst b/ulib/FStar.Tactics.V2.SyntaxHelpers.fst index 9f64775ce79..ebce070cb6d 100644 --- a/ulib/FStar.Tactics.V2.SyntaxHelpers.fst +++ b/ulib/FStar.Tactics.V2.SyntaxHelpers.fst @@ -86,3 +86,11 @@ let rec collect_app' (args : list argv) (t : term) | _ -> (t, args) let collect_app = collect_app' [] + +(* Destruct an application into [h]ead fv, [u]niverses, and [a]rguments. *) +let hua (t:term) : Tac (option (fv & universes & list argv)) = + let hd, args = collect_app t in + match inspect hd with + | Tv_FVar fv -> Some (fv, [], args) + | Tv_UInst fv us -> Some (fv, us, args) + | _ -> None From 6a082fa3dcdef123a455fe49d85d3739a9ad37a9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 20 May 2024 10:46:56 -0700 Subject: [PATCH 220/239] Syntax.Free: use a binary operator for union Much more readable. --- src/syntax/FStar.Syntax.Free.fst | 85 +++++++++++++++++--------------- 1 file changed, 44 insertions(+), 41 deletions(-) diff --git a/src/syntax/FStar.Syntax.Free.fst b/src/syntax/FStar.Syntax.Free.fst index b3caaa803c4..e9a292191df 100644 --- a/src/syntax/FStar.Syntax.Free.fst +++ b/src/syntax/FStar.Syntax.Free.fst @@ -98,7 +98,8 @@ let singleton_univ x = let singleton_univ_name x = {fst no_free_vars with free_univ_names = singleton x}, snd no_free_vars -let union (f1 : free_vars_and_fvars) (f2 : free_vars_and_fvars) = { +(* Union of free vars *) +let ( ++ ) (f1 : free_vars_and_fvars) (f2 : free_vars_and_fvars) = { free_names=(fst f1).free_names `union` (fst f2).free_names; free_uvars=(fst f1).free_uvars `union` (fst f2).free_uvars; free_univs=(fst f1).free_univs `union` (fst f2).free_univs; @@ -112,7 +113,7 @@ let rec free_univs u = match Subst.compress_univ u with | U_unknown -> no_free_vars | U_name uname -> singleton_univ_name uname | U_succ u -> free_univs u - | U_max us -> List.fold_left (fun out x -> union out (free_univs x)) no_free_vars us + | U_max us -> List.fold_left (fun out x -> out ++ free_univs x) no_free_vars us | U_unif u -> singleton_univ u //the interface of Syntax.Free now supports getting fvars in a term also @@ -126,7 +127,7 @@ let rec free_univs u = match Subst.compress_univ u with let rec free_names_and_uvs' tm (use_cache:use_cache_t) : free_vars_and_fvars = let aux_binders (bs : binders) (from_body : free_vars_and_fvars) = let from_binders = free_names_and_uvars_binders bs use_cache in - union from_binders from_body + from_binders ++ from_body in let t = Subst.compress tm in match t.n with @@ -136,8 +137,10 @@ let rec free_names_and_uvs' tm (use_cache:use_cache_t) : free_vars_and_fvars = singleton_bv x | Tm_uvar (uv, (s, _)) -> - union (singleton_uv uv) - (if use_cache = Full then free_names_and_uvars (ctx_uvar_typ uv) use_cache else no_free_vars) + singleton_uv uv ++ + (if use_cache = Full + then free_names_and_uvars (ctx_uvar_typ uv) use_cache + else no_free_vars) | Tm_type u -> free_univs u @@ -152,13 +155,13 @@ let rec free_names_and_uvs' tm (use_cache:use_cache_t) : free_vars_and_fvars = | Tm_uinst(t, us) -> let f = free_names_and_uvars t use_cache in - List.fold_left (fun out u -> union out (free_univs u)) f us + List.fold_left (fun out u -> out ++ free_univs u) f us | Tm_abs {bs; body=t; rc_opt=ropt} -> - union (aux_binders bs (free_names_and_uvars t use_cache)) - (match ropt with - | Some { residual_typ = Some t } -> free_names_and_uvars t use_cache - | _ -> no_free_vars) + aux_binders bs (free_names_and_uvars t use_cache) ++ + (match ropt with + | Some { residual_typ = Some t } -> free_names_and_uvars t use_cache + | _ -> no_free_vars) | Tm_arrow {bs; comp=c} -> aux_binders bs (free_names_and_uvars_comp c use_cache) @@ -169,7 +172,7 @@ let rec free_names_and_uvs' tm (use_cache:use_cache_t) : free_vars_and_fvars = | Tm_app {hd=t; args} -> free_names_and_uvars_args args (free_names_and_uvars t use_cache) use_cache - | Tm_match {scrutinee=t; ret_opt=asc_opt; brs=pats} -> + | Tm_match {scrutinee=t; ret_opt=asc_opt; brs=pats; rc_opt} -> pats |> List.fold_left (fun n (p, wopt, t) -> let n1 = match wopt with | None -> no_free_vars @@ -177,29 +180,30 @@ let rec free_names_and_uvs' tm (use_cache:use_cache_t) : free_vars_and_fvars = in let n2 = free_names_and_uvars t use_cache in let n = - pat_bvs p |> List.fold_left (fun n x -> union n (free_names_and_uvars x.sort use_cache)) n + pat_bvs p |> List.fold_left (fun n x -> n ++ free_names_and_uvars x.sort use_cache) n in - union n (union n1 n2)) - (union (free_names_and_uvars t use_cache) - (match asc_opt with - | None -> no_free_vars - | Some (b, asc) -> - union - (free_names_and_uvars_binders [b] use_cache) - (free_names_and_uvars_ascription asc use_cache))) + n ++ n1 ++ n2) + (free_names_and_uvars t use_cache + ++ (match asc_opt with + | None -> no_free_vars + | Some (b, asc) -> + free_names_and_uvars_binders [b] use_cache ++ + free_names_and_uvars_ascription asc use_cache)) | Tm_ascribed {tm=t1; asc} -> - union (free_names_and_uvars t1 use_cache) - (free_names_and_uvars_ascription asc use_cache) + free_names_and_uvars t1 use_cache ++ + free_names_and_uvars_ascription asc use_cache | Tm_let {lbs; body=t} -> snd lbs |> List.fold_left (fun n lb -> - union n (union (free_names_and_uvars lb.lbtyp use_cache) (free_names_and_uvars lb.lbdef use_cache))) - (free_names_and_uvars t use_cache) + n ++ + free_names_and_uvars lb.lbtyp use_cache ++ + free_names_and_uvars lb.lbdef use_cache) + (free_names_and_uvars t use_cache) | Tm_quoted (tm, qi) -> begin match qi.qkind with - | Quote_static -> List.fold_left (fun n t -> union n (free_names_and_uvars t use_cache)) no_free_vars (snd qi.antiquotations) + | Quote_static -> List.fold_left (fun n t -> n ++ free_names_and_uvars t use_cache) no_free_vars (snd qi.antiquotations) | Quote_dynamic -> free_names_and_uvars tm use_cache end @@ -210,10 +214,10 @@ let rec free_names_and_uvs' tm (use_cache:use_cache_t) : free_vars_and_fvars = List.fold_right (fun a acc -> free_names_and_uvars_args a acc use_cache) args u1 | Meta_monadic(_, t') -> - union u1 (free_names_and_uvars t' use_cache) + u1 ++ free_names_and_uvars t' use_cache | Meta_monadic_lift(_, _, t') -> - union u1 (free_names_and_uvars t' use_cache) + u1 ++ free_names_and_uvars t' use_cache | Meta_labeled _ | Meta_desugared _ @@ -223,18 +227,17 @@ let rec free_names_and_uvs' tm (use_cache:use_cache_t) : free_vars_and_fvars = and free_names_and_uvars_binders bs use_cache = bs |> List.fold_left (fun n b -> - union n (free_names_and_uvars b.binder_bv.sort use_cache)) no_free_vars + n ++ free_names_and_uvars b.binder_bv.sort use_cache) no_free_vars and free_names_and_uvars_ascription asc use_cache = let asc, tacopt, _ = asc in - union (match asc with - | Inl t -> free_names_and_uvars t use_cache - | Inr c -> free_names_and_uvars_comp c use_cache) - (match tacopt with - | None -> no_free_vars - | Some tac -> free_names_and_uvars tac use_cache) - + (match asc with + | Inl t -> free_names_and_uvars t use_cache + | Inr c -> free_names_and_uvars_comp c use_cache) ++ + (match tacopt with + | None -> no_free_vars + | Some tac -> free_names_and_uvars tac use_cache) and free_names_and_uvars t use_cache = let t = Subst.compress t in @@ -247,7 +250,7 @@ and free_names_and_uvars t use_cache = n and free_names_and_uvars_args args (acc : free_vars_and_fvars) use_cache = - args |> List.fold_left (fun n (x, _) -> union n (free_names_and_uvars x use_cache)) acc + args |> List.fold_left (fun n (x, _) -> n ++ (free_names_and_uvars x use_cache)) acc and free_names_and_uvars_comp c use_cache = match !c.vars with @@ -270,11 +273,11 @@ and free_names_and_uvars_comp c use_cache = free_names_and_uvars_dec_order dec_order use_cache in //decreases clause + return type - let us = union (free_names_and_uvars ct.result_typ use_cache) decreases_vars in + let us = free_names_and_uvars ct.result_typ use_cache ++ decreases_vars in //decreases clause + return type + effect args let us = free_names_and_uvars_args ct.effect_args us use_cache in //decreases clause + return type + effect args + comp_univs - List.fold_left (fun us u -> union us (free_univs u)) us ct.comp_univs + List.fold_left (fun us u -> us ++ free_univs u) us ct.comp_univs in c.vars := Some (fst n); n @@ -282,10 +285,10 @@ and free_names_and_uvars_comp c use_cache = and free_names_and_uvars_dec_order dec_order use_cache = match dec_order with | Decreases_lex l -> - l |> List.fold_left (fun acc t -> union acc (free_names_and_uvars t use_cache)) no_free_vars + l |> List.fold_left (fun acc t -> acc ++ free_names_and_uvars t use_cache) no_free_vars | Decreases_wf (rel, e) -> - union (free_names_and_uvars rel use_cache) - (free_names_and_uvars e use_cache) + free_names_and_uvars rel use_cache ++ + free_names_and_uvars e use_cache and should_invalidate_cache n use_cache = (use_cache <> Def) || From dcdda279331da5d6ac163662b7e2d75b9d81cf72 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 20 May 2024 10:48:58 -0700 Subject: [PATCH 221/239] Syntax.Free: consider vars in residual comp of match --- src/syntax/FStar.Syntax.Free.fst | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/syntax/FStar.Syntax.Free.fst b/src/syntax/FStar.Syntax.Free.fst index e9a292191df..25cb0cda744 100644 --- a/src/syntax/FStar.Syntax.Free.fst +++ b/src/syntax/FStar.Syntax.Free.fst @@ -173,6 +173,10 @@ let rec free_names_and_uvs' tm (use_cache:use_cache_t) : free_vars_and_fvars = free_names_and_uvars_args args (free_names_and_uvars t use_cache) use_cache | Tm_match {scrutinee=t; ret_opt=asc_opt; brs=pats; rc_opt} -> + (match rc_opt with + | Some { residual_typ = Some t } -> free_names_and_uvars t use_cache + | None -> no_free_vars) ++ + begin pats |> List.fold_left (fun n (p, wopt, t) -> let n1 = match wopt with | None -> no_free_vars @@ -189,6 +193,7 @@ let rec free_names_and_uvs' tm (use_cache:use_cache_t) : free_vars_and_fvars = | Some (b, asc) -> free_names_and_uvars_binders [b] use_cache ++ free_names_and_uvars_ascription asc use_cache)) + end | Tm_ascribed {tm=t1; asc} -> free_names_and_uvars t1 use_cache ++ From 3da0899bc97bc4a1652704a7130e529f3f0fb292 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 20 May 2024 13:17:36 -0700 Subject: [PATCH 222/239] Tactics: adding a norm_well_typed_term reflection call --- ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml | 2 ++ src/tactics/FStar.Tactics.V2.Basic.fst | 14 +++++++++++--- src/tactics/FStar.Tactics.V2.Basic.fsti | 1 + src/tactics/FStar.Tactics.V2.Primops.fst | 2 ++ ulib/FStar.Stubs.Tactics.V2.Builtins.fsti | 10 ++++++++++ 5 files changed, 26 insertions(+), 3 deletions(-) diff --git a/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml b/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml index a24499a2a90..fb1f5260e39 100644 --- a/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml +++ b/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml @@ -155,6 +155,8 @@ let instantiate_implicits = from_tac_2 "B.refl_instantiate_implicits" B.r let try_unify = from_tac_4 "B.refl_try_unify" B.refl_try_unify let maybe_relate_after_unfolding = from_tac_3 "B.refl_maybe_relate_after_unfolding" B.refl_maybe_relate_after_unfolding let maybe_unfold_head = from_tac_2 "B.refl_maybe_unfold_head" B.refl_maybe_unfold_head +let norm_well_typed_term = from_tac_3 "B.norm_well_typed_term" B.refl_norm_well_typed_term + let push_open_namespace = from_tac_2 "B.push_open_namespace" B.push_open_namespace let push_module_abbrev = from_tac_3 "B.push_module_abbrev" B.push_module_abbrev let resolve_name = from_tac_2 "B.resolve_name" B.resolve_name diff --git a/src/tactics/FStar.Tactics.V2.Basic.fst b/src/tactics/FStar.Tactics.V2.Basic.fst index 0dc2521d213..3679c59562b 100644 --- a/src/tactics/FStar.Tactics.V2.Basic.fst +++ b/src/tactics/FStar.Tactics.V2.Basic.fst @@ -817,18 +817,26 @@ let norm (s : list Pervasives.norm_step) : tac unit = let t = normalize steps (goal_env goal) (goal_type goal) in replace_cur (goal_with_type goal t) - -let norm_term_env (e : env) (s : list Pervasives.norm_step) (t : term) : tac term = wrap_err "norm_term" <| ( +let __norm_term_env + (well_typed:bool) (e : env) (s : list Pervasives.norm_step) (t : term) + : tac term += wrap_err "norm_term" <| ( let! ps = get in if_verbose (fun () -> BU.print1 "norm_term_env: t = %s\n" (show t)) ;! // only for elaborating lifts and all that, we don't care if it's actually well-typed - let! t, _, _ = __tc_lax e t in + let! t = + if well_typed + then return t + else let! t, _, _ = __tc_lax e t in return t + in let steps = [Env.Reify; Env.UnfoldTac]@(Cfg.translate_norm_steps s) in let t = normalize steps ps.main_context t in if_verbose (fun () -> BU.print1 "norm_term_env: t' = %s\n" (show t)) ;! return t ) +let norm_term_env e s t = __norm_term_env false e s t +let refl_norm_well_typed_term e s t = __norm_term_env true e s t let refine_intro () : tac unit = wrap_err "refine_intro" <| ( let! g = cur_goal in diff --git a/src/tactics/FStar.Tactics.V2.Basic.fsti b/src/tactics/FStar.Tactics.V2.Basic.fsti index bdbd3ced32f..4b7a9756e5f 100644 --- a/src/tactics/FStar.Tactics.V2.Basic.fsti +++ b/src/tactics/FStar.Tactics.V2.Basic.fsti @@ -140,6 +140,7 @@ val refl_instantiate_implicits : env -> term -> tac (option (list (bv & t val refl_try_unify : env -> list (bv & typ) -> term -> term -> tac (option (list (bv & term)) & issues) val refl_maybe_relate_after_unfolding : env -> term -> term -> tac (option Core.side & issues) val refl_maybe_unfold_head : env -> term -> tac (option term & issues) +val refl_norm_well_typed_term : env -> list norm_step -> term -> tac term val push_open_namespace : env -> list string -> tac env val push_module_abbrev : env -> string -> list string -> tac env diff --git a/src/tactics/FStar.Tactics.V2.Primops.fst b/src/tactics/FStar.Tactics.V2.Primops.fst index 13f9e4e847b..73d803b88cf 100644 --- a/src/tactics/FStar.Tactics.V2.Primops.fst +++ b/src/tactics/FStar.Tactics.V2.Primops.fst @@ -261,6 +261,8 @@ let ops = [ refl_try_unify refl_try_unify; mk_tac_step_3 0 "maybe_relate_after_unfolding" refl_maybe_relate_after_unfolding refl_maybe_relate_after_unfolding; mk_tac_step_2 0 "maybe_unfold_head" refl_maybe_unfold_head refl_maybe_unfold_head; + mk_tac_step_3 0 "norm_well_typed_term" refl_norm_well_typed_term refl_norm_well_typed_term; + mk_tac_step_2 0 "push_open_namespace" push_open_namespace push_open_namespace; mk_tac_step_3 0 "push_module_abbrev" push_module_abbrev push_module_abbrev; mk_tac_step_2 0 "resolve_name" diff --git a/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti b/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti index c1bca5f7841..1356f70723b 100644 --- a/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti +++ b/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti @@ -577,6 +577,16 @@ val maybe_relate_after_unfolding (g:env) (t1 t2:term) val maybe_unfold_head (g:env) (t0:term) : Tac (ret_t (t1:term{equiv_token g t0 t1})) +(** [norm_well_typed_term e steps t] will call the normalizer on the +term [t] using the list of steps [steps], over environment [e]. It +differs from norm_term_env in that it will not attempt to typecheck t +(so there is an implicit well-typing precondition for t, which we are +not strcitly requiring yet in reflection primitives) and it will also +return a token for the equivalence between t and t'. *) +val norm_well_typed_term + (g:env) (steps : list norm_step) (t:term) + : Tac (t':term{equiv_token g t t'}) + val push_open_namespace (g:env) (ns:name) : Tac env From 2b7166eb43da555eb4f3ece5a99f3e2a4fd9139c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 20 May 2024 13:55:06 -0700 Subject: [PATCH 223/239] SMTEncoding: introduce --debug SMTFail to print a diagnostic for failing queries --- src/smtencoding/FStar.SMTEncoding.Solver.fst | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/src/smtencoding/FStar.SMTEncoding.Solver.fst b/src/smtencoding/FStar.SMTEncoding.Solver.fst index c51e7b97a16..1445c9a48e7 100644 --- a/src/smtencoding/FStar.SMTEncoding.Solver.fst +++ b/src/smtencoding/FStar.SMTEncoding.Solver.fst @@ -41,6 +41,8 @@ module TcUtil = FStar.TypeChecker.Util module U = FStar.Syntax.Util exception SplitQueryAndRetry +let dbg_SMTFail = Debug.get_toggle "SMTFail" + (****************************************************************************) (* Hint databases for record and replay (private) *) (****************************************************************************) @@ -1107,6 +1109,7 @@ let ask_solver_recover let failing_query_ctr : ref int = BU.mk_ref 0 let maybe_save_failing_query (env:env_t) (prefix:list decl) (qs:query_settings) : unit = + (* Save failing query to a clean file if --log_failing_queries. *) if Options.log_failing_queries () then ( let mod = show (Env.current_module env) in let n = (failing_query_ctr := !failing_query_ctr + 1; !failing_query_ctr) in @@ -1121,7 +1124,18 @@ let maybe_save_failing_query (env:env_t) (prefix:list decl) (qs:query_settings) in write_file file_name query_str; () - ) + ); + (* Also print it out if --debug SMTFail. *) + if !dbg_SMTFail then ( + let open FStar.Pprint in + let open FStar.Class.PP in + let open FStar.Errors.Msg in + Errors.diag_doc qs.query_range [ + text "This query failed:"; + pp qs.query_term; + ] + ); + () let ask_solver (can_split : bool) From 3c11db44e092baef8d21de95eb836fadadceb7eb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 20 May 2024 18:37:08 -0700 Subject: [PATCH 224/239] snap --- .../generated/FStar_SMTEncoding_Solver.ml | 75 +- .../fstar-lib/generated/FStar_Syntax_Free.ml | 126 +- .../generated/FStar_Tactics_Typeclasses.ml | 1063 ++++++++--------- .../generated/FStar_Tactics_Types.ml | 3 + .../generated/FStar_Tactics_V2_Basic.ml | 245 ++-- .../generated/FStar_Tactics_V2_Primops.ml | 48 +- .../FStar_Tactics_V2_SyntaxHelpers.ml | 50 +- .../generated/FStar_TypeChecker_Err.ml | 45 +- .../generated/FStar_TypeChecker_Rel.ml | 4 +- .../generated/FStar_TypeChecker_TcTerm.ml | 2 +- .../generated/FStar_TypeChecker_Util.ml | 3 +- 11 files changed, 925 insertions(+), 739 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml index 9aa4beca0e8..42de7061bc1 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml @@ -3,6 +3,8 @@ exception SplitQueryAndRetry let (uu___is_SplitQueryAndRetry : Prims.exn -> Prims.bool) = fun projectee -> match projectee with | SplitQueryAndRetry -> true | uu___ -> false +let (dbg_SMTFail : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "SMTFail" let (z3_replay_result : (unit * unit)) = ((), ()) let z3_result_as_replay_result : 'uuuuu 'uuuuu1 'uuuuu2 . @@ -1882,36 +1884,49 @@ let (maybe_save_failing_query : fun env -> fun prefix -> fun qs -> - let uu___ = FStar_Options.log_failing_queries () in - if uu___ - then - let mod1 = - let uu___1 = FStar_TypeChecker_Env.current_module env in - FStar_Class_Show.show FStar_Ident.showable_lident uu___1 in - let n = - (let uu___2 = - let uu___3 = FStar_Compiler_Effect.op_Bang failing_query_ctr in - uu___3 + Prims.int_one in - FStar_Compiler_Effect.op_Colon_Equals failing_query_ctr uu___2); - FStar_Compiler_Effect.op_Bang failing_query_ctr in - let file_name = - let uu___1 = - FStar_Class_Show.show - (FStar_Class_Show.printableshow - FStar_Class_Printable.printable_int) n in - FStar_Compiler_Util.format2 "failedQueries-%s-%s.smt2" mod1 - uu___1 in - let query_str = - let uu___1 = with_fuel_and_diagnostics qs [] in - let uu___2 = - let uu___3 = FStar_Compiler_Util.string_of_int qs.query_index in - FStar_Compiler_Util.format2 "(%s, %s)" qs.query_name uu___3 in - FStar_SMTEncoding_Z3.ask_text qs.query_range - (filter_assertions qs.query_env FStar_Pervasives_Native.None - qs.query_hint) qs.query_hash qs.query_all_labels uu___1 - uu___2 in - FStar_Compiler_Util.write_file file_name query_str - else () + (let uu___1 = FStar_Options.log_failing_queries () in + if uu___1 + then + let mod1 = + let uu___2 = FStar_TypeChecker_Env.current_module env in + FStar_Class_Show.show FStar_Ident.showable_lident uu___2 in + let n = + (let uu___3 = + let uu___4 = FStar_Compiler_Effect.op_Bang failing_query_ctr in + uu___4 + Prims.int_one in + FStar_Compiler_Effect.op_Colon_Equals failing_query_ctr uu___3); + FStar_Compiler_Effect.op_Bang failing_query_ctr in + let file_name = + let uu___2 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) n in + FStar_Compiler_Util.format2 "failedQueries-%s-%s.smt2" mod1 + uu___2 in + let query_str = + let uu___2 = with_fuel_and_diagnostics qs [] in + let uu___3 = + let uu___4 = FStar_Compiler_Util.string_of_int qs.query_index in + FStar_Compiler_Util.format2 "(%s, %s)" qs.query_name uu___4 in + FStar_SMTEncoding_Z3.ask_text qs.query_range + (filter_assertions qs.query_env FStar_Pervasives_Native.None + qs.query_hint) qs.query_hash qs.query_all_labels uu___2 + uu___3 in + FStar_Compiler_Util.write_file file_name query_str + else ()); + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_SMTFail in + if uu___2 + then + let uu___3 = + let uu___4 = FStar_Errors_Msg.text "This query failed:" in + let uu___5 = + let uu___6 = + FStar_Class_PP.pp FStar_Syntax_Print.pretty_term + qs.query_term in + [uu___6] in + uu___4 :: uu___5 in + FStar_Errors.diag_doc qs.query_range uu___3 + else ()) let (ask_solver : Prims.bool -> Prims.bool -> diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml index 4902c07cab1..0686cff0efc 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml @@ -254,7 +254,7 @@ let (singleton_univ_name : FStar_Syntax_Syntax.free_univ_names = uu___2 } in (uu___, (FStar_Pervasives_Native.snd no_free_vars)) -let (union : +let (op_Plus_Plus : free_vars_and_fvars -> free_vars_and_fvars -> (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident @@ -327,7 +327,8 @@ let rec (free_univs : FStar_Syntax_Syntax.universe -> free_vars_and_fvars) = | FStar_Syntax_Syntax.U_succ u1 -> free_univs u1 | FStar_Syntax_Syntax.U_max us -> FStar_Compiler_List.fold_left - (fun out -> fun x -> let uu___1 = free_univs x in union out uu___1) + (fun out -> + fun x -> let uu___1 = free_univs x in op_Plus_Plus out uu___1) no_free_vars us | FStar_Syntax_Syntax.U_unif u1 -> singleton_univ u1 let rec (free_names_and_uvs' : @@ -336,7 +337,7 @@ let rec (free_names_and_uvs' : fun use_cache -> let aux_binders bs from_body = let from_binders = free_names_and_uvars_binders bs use_cache in - union from_binders from_body in + op_Plus_Plus from_binders from_body in let t = FStar_Syntax_Subst.compress tm in match t.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_delayed uu___ -> @@ -350,7 +351,7 @@ let rec (free_names_and_uvs' : let uu___3 = ctx_uvar_typ uv in free_names_and_uvars uu___3 use_cache else no_free_vars in - union uu___1 uu___2 + op_Plus_Plus uu___1 uu___2 | FStar_Syntax_Syntax.Tm_type u -> free_univs u | FStar_Syntax_Syntax.Tm_bvar uu___ -> no_free_vars | FStar_Syntax_Syntax.Tm_fvar fv -> singleton_fvar fv @@ -360,8 +361,9 @@ let rec (free_names_and_uvs' : | FStar_Syntax_Syntax.Tm_uinst (t1, us) -> let f = free_names_and_uvars t1 use_cache in FStar_Compiler_List.fold_left - (fun out -> fun u -> let uu___ = free_univs u in union out uu___) - f us + (fun out -> + fun u -> let uu___ = free_univs u in op_Plus_Plus out uu___) f + us | FStar_Syntax_Syntax.Tm_abs { FStar_Syntax_Syntax.bs = bs; FStar_Syntax_Syntax.body = t1; FStar_Syntax_Syntax.rc_opt = ropt;_} @@ -378,7 +380,7 @@ let rec (free_names_and_uvs' : FStar_Syntax_Syntax.residual_flags = uu___3;_} -> free_names_and_uvars t2 use_cache | uu___2 -> no_free_vars in - union uu___ uu___1 + op_Plus_Plus uu___ uu___1 | FStar_Syntax_Syntax.Tm_arrow { FStar_Syntax_Syntax.bs1 = bs; FStar_Syntax_Syntax.comp = c;_} -> let uu___ = free_names_and_uvars_comp c use_cache in @@ -398,46 +400,59 @@ let rec (free_names_and_uvs' : { FStar_Syntax_Syntax.scrutinee = t1; FStar_Syntax_Syntax.ret_opt = asc_opt; FStar_Syntax_Syntax.brs = pats; - FStar_Syntax_Syntax.rc_opt1 = uu___;_} + FStar_Syntax_Syntax.rc_opt1 = rc_opt;_} -> + let uu___ = + match rc_opt with + | FStar_Pervasives_Native.Some + { FStar_Syntax_Syntax.residual_effect = uu___1; + FStar_Syntax_Syntax.residual_typ = + FStar_Pervasives_Native.Some t2; + FStar_Syntax_Syntax.residual_flags = uu___2;_} + -> free_names_and_uvars t2 use_cache + | FStar_Pervasives_Native.None -> no_free_vars in let uu___1 = - let uu___2 = free_names_and_uvars t1 use_cache in - let uu___3 = - match asc_opt with - | FStar_Pervasives_Native.None -> no_free_vars - | FStar_Pervasives_Native.Some (b, asc) -> - let uu___4 = free_names_and_uvars_binders [b] use_cache in - let uu___5 = free_names_and_uvars_ascription asc use_cache in - union uu___4 uu___5 in - union uu___2 uu___3 in - FStar_Compiler_List.fold_left - (fun n -> - fun uu___2 -> - match uu___2 with - | (p, wopt, t2) -> - let n1 = - match wopt with - | FStar_Pervasives_Native.None -> no_free_vars - | FStar_Pervasives_Native.Some w -> - free_names_and_uvars w use_cache in - let n2 = free_names_and_uvars t2 use_cache in - let n3 = - let uu___3 = FStar_Syntax_Syntax.pat_bvs p in - FStar_Compiler_List.fold_left - (fun n4 -> - fun x -> - let uu___4 = - free_names_and_uvars - x.FStar_Syntax_Syntax.sort use_cache in - union n4 uu___4) n uu___3 in - let uu___3 = union n1 n2 in union n3 uu___3) uu___1 pats + let uu___2 = + let uu___3 = free_names_and_uvars t1 use_cache in + let uu___4 = + match asc_opt with + | FStar_Pervasives_Native.None -> no_free_vars + | FStar_Pervasives_Native.Some (b, asc) -> + let uu___5 = free_names_and_uvars_binders [b] use_cache in + let uu___6 = + free_names_and_uvars_ascription asc use_cache in + op_Plus_Plus uu___5 uu___6 in + op_Plus_Plus uu___3 uu___4 in + FStar_Compiler_List.fold_left + (fun n -> + fun uu___3 -> + match uu___3 with + | (p, wopt, t2) -> + let n1 = + match wopt with + | FStar_Pervasives_Native.None -> no_free_vars + | FStar_Pervasives_Native.Some w -> + free_names_and_uvars w use_cache in + let n2 = free_names_and_uvars t2 use_cache in + let n3 = + let uu___4 = FStar_Syntax_Syntax.pat_bvs p in + FStar_Compiler_List.fold_left + (fun n4 -> + fun x -> + let uu___5 = + free_names_and_uvars + x.FStar_Syntax_Syntax.sort use_cache in + op_Plus_Plus n4 uu___5) n uu___4 in + let uu___4 = op_Plus_Plus n3 n1 in + op_Plus_Plus uu___4 n2) uu___2 pats in + op_Plus_Plus uu___ uu___1 | FStar_Syntax_Syntax.Tm_ascribed { FStar_Syntax_Syntax.tm = t1; FStar_Syntax_Syntax.asc = asc; FStar_Syntax_Syntax.eff_opt = uu___;_} -> let uu___1 = free_names_and_uvars t1 use_cache in let uu___2 = free_names_and_uvars_ascription asc use_cache in - union uu___1 uu___2 + op_Plus_Plus uu___1 uu___2 | FStar_Syntax_Syntax.Tm_let { FStar_Syntax_Syntax.lbs = lbs; FStar_Syntax_Syntax.body1 = t1;_} -> @@ -449,11 +464,12 @@ let rec (free_names_and_uvs' : let uu___2 = free_names_and_uvars lb.FStar_Syntax_Syntax.lbtyp use_cache in - let uu___3 = - free_names_and_uvars lb.FStar_Syntax_Syntax.lbdef - use_cache in - union uu___2 uu___3 in - union n uu___1) uu___ (FStar_Pervasives_Native.snd lbs) + op_Plus_Plus n uu___2 in + let uu___2 = + free_names_and_uvars lb.FStar_Syntax_Syntax.lbdef + use_cache in + op_Plus_Plus uu___1 uu___2) uu___ + (FStar_Pervasives_Native.snd lbs) | FStar_Syntax_Syntax.Tm_quoted (tm1, qi) -> (match qi.FStar_Syntax_Syntax.qkind with | FStar_Syntax_Syntax.Quote_static -> @@ -461,7 +477,7 @@ let rec (free_names_and_uvs' : (fun n -> fun t1 -> let uu___ = free_names_and_uvars t1 use_cache in - union n uu___) no_free_vars + op_Plus_Plus n uu___) no_free_vars (FStar_Pervasives_Native.snd qi.FStar_Syntax_Syntax.antiquotations) | FStar_Syntax_Syntax.Quote_dynamic -> @@ -477,10 +493,10 @@ let rec (free_names_and_uvs' : args u1 | FStar_Syntax_Syntax.Meta_monadic (uu___, t') -> let uu___1 = free_names_and_uvars t' use_cache in - union u1 uu___1 + op_Plus_Plus u1 uu___1 | FStar_Syntax_Syntax.Meta_monadic_lift (uu___, uu___1, t') -> let uu___2 = free_names_and_uvars t' use_cache in - union u1 uu___2 + op_Plus_Plus u1 uu___2 | FStar_Syntax_Syntax.Meta_labeled uu___ -> u1 | FStar_Syntax_Syntax.Meta_desugared uu___ -> u1 | FStar_Syntax_Syntax.Meta_named uu___ -> u1) @@ -495,7 +511,7 @@ and (free_names_and_uvars_binders : free_names_and_uvars (b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort use_cache in - union n uu___) no_free_vars bs + op_Plus_Plus n uu___) no_free_vars bs and (free_names_and_uvars_ascription : ((FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax, FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax) @@ -517,7 +533,7 @@ and (free_names_and_uvars_ascription : | FStar_Pervasives_Native.None -> no_free_vars | FStar_Pervasives_Native.Some tac -> free_names_and_uvars tac use_cache in - union uu___2 uu___3 + op_Plus_Plus uu___2 uu___3 and (free_names_and_uvars : FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> use_cache_t -> free_vars_and_fvars) @@ -562,7 +578,7 @@ and (free_names_and_uvars_args : match uu___ with | (x, uu___1) -> let uu___2 = free_names_and_uvars x use_cache in - union n uu___2) acc args + op_Plus_Plus n uu___2) acc args and (free_names_and_uvars_comp : FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> use_cache_t -> free_vars_and_fvars) @@ -609,13 +625,14 @@ and (free_names_and_uvars_comp : let uu___2 = free_names_and_uvars ct.FStar_Syntax_Syntax.result_typ use_cache in - union uu___2 decreases_vars in + op_Plus_Plus uu___2 decreases_vars in let us1 = free_names_and_uvars_args ct.FStar_Syntax_Syntax.effect_args us use_cache in FStar_Compiler_List.fold_left (fun us2 -> - fun u -> let uu___2 = free_univs u in union us2 uu___2) + fun u -> + let uu___2 = free_univs u in op_Plus_Plus us2 uu___2) us1 ct.FStar_Syntax_Syntax.comp_univs in (FStar_Compiler_Effect.op_Colon_Equals c.FStar_Syntax_Syntax.vars (FStar_Pervasives_Native.Some (FStar_Pervasives_Native.fst n)); @@ -631,10 +648,11 @@ and (free_names_and_uvars_dec_order : (fun acc -> fun t -> let uu___ = free_names_and_uvars t use_cache in - union acc uu___) no_free_vars l + op_Plus_Plus acc uu___) no_free_vars l | FStar_Syntax_Syntax.Decreases_wf (rel, e) -> let uu___ = free_names_and_uvars rel use_cache in - let uu___1 = free_names_and_uvars e use_cache in union uu___ uu___1 + let uu___1 = free_names_and_uvars e use_cache in + op_Plus_Plus uu___ uu___1 and (should_invalidate_cache : FStar_Syntax_Syntax.free_vars -> use_cache_t -> Prims.bool) = fun n -> diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml index eb41d6dddac..c18e1a96e85 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml @@ -139,55 +139,6 @@ let rec (head_of : (Obj.repr (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> FStar_Pervasives_Native.None)))) uu___) -let (hua : - FStar_Tactics_NamedView.term -> - ((FStar_Reflection_Types.fv * FStar_Reflection_V2_Data.universes * - FStar_Reflection_V2_Data.argv Prims.list) - FStar_Pervasives_Native.option, - unit) FStar_Tactics_Effect.tac_repr) - = - fun t -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (93)) (Prims.of_int (17)) (Prims.of_int (93)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (92)) (Prims.of_int (62)) (Prims.of_int (97)) - (Prims.of_int (13))))) - (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_app t)) - (fun uu___ -> - (fun uu___ -> - match uu___ with - | (hd, args) -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (94)) (Prims.of_int (8)) - (Prims.of_int (94)) (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (94)) (Prims.of_int (2)) - (Prims.of_int (97)) (Prims.of_int (13))))) - (Obj.magic (FStar_Tactics_NamedView.inspect hd)) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - match uu___1 with - | FStar_Tactics_NamedView.Tv_FVar fv -> - FStar_Pervasives_Native.Some (fv, [], args) - | FStar_Tactics_NamedView.Tv_UInst (fv, us) -> - FStar_Pervasives_Native.Some (fv, us, args) - | uu___3 -> FStar_Pervasives_Native.None)))) - uu___) let rec (res_typ : FStar_Tactics_NamedView.term -> (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) @@ -197,12 +148,12 @@ let rec (res_typ : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (100)) (Prims.of_int (8)) (Prims.of_int (100)) + (Prims.of_int (93)) (Prims.of_int (8)) (Prims.of_int (93)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (100)) (Prims.of_int (2)) (Prims.of_int (106)) + (Prims.of_int (93)) (Prims.of_int (2)) (Prims.of_int (99)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_NamedView.inspect t)) (fun uu___ -> @@ -248,12 +199,12 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (121)) (Prims.of_int (10)) (Prims.of_int (121)) + (Prims.of_int (114)) (Prims.of_int (10)) (Prims.of_int (114)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (122)) (Prims.of_int (2)) (Prims.of_int (126)) + (Prims.of_int (115)) (Prims.of_int (2)) (Prims.of_int (119)) (Prims.of_int (11))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_goal ())) (fun uu___1 -> @@ -263,13 +214,13 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (122)) (Prims.of_int (8)) - (Prims.of_int (122)) (Prims.of_int (17))))) + (Prims.of_int (115)) (Prims.of_int (8)) + (Prims.of_int (115)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (122)) (Prims.of_int (2)) - (Prims.of_int (126)) (Prims.of_int (11))))) + (Prims.of_int (115)) (Prims.of_int (2)) + (Prims.of_int (119)) (Prims.of_int (11))))) (Obj.magic (FStar_Tactics_NamedView.inspect g)) (fun uu___1 -> (fun uu___1 -> @@ -282,17 +233,17 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (124)) + (Prims.of_int (117)) (Prims.of_int (4)) - (Prims.of_int (124)) + (Prims.of_int (117)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (125)) + (Prims.of_int (118)) (Prims.of_int (4)) - (Prims.of_int (125)) + (Prims.of_int (118)) (Prims.of_int (19))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -300,17 +251,17 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (124)) + (Prims.of_int (117)) (Prims.of_int (11)) - (Prims.of_int (124)) + (Prims.of_int (117)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (124)) + (Prims.of_int (117)) (Prims.of_int (4)) - (Prims.of_int (124)) + (Prims.of_int (117)) (Prims.of_int (21))))) (Obj.magic (FStar_Tactics_V2_Builtins.intro @@ -369,13 +320,14 @@ let rec unembed_list : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (145)) (Prims.of_int (8)) (Prims.of_int (145)) + (Prims.of_int (138)) (Prims.of_int (8)) (Prims.of_int (138)) (Prims.of_int (13))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (145)) (Prims.of_int (2)) (Prims.of_int (159)) - (Prims.of_int (8))))) (Obj.magic (hua t)) + (Prims.of_int (138)) (Prims.of_int (2)) (Prims.of_int (152)) + (Prims.of_int (8))))) + (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.hua t)) (fun uu___ -> (fun uu___ -> match uu___ with @@ -398,17 +350,17 @@ let rec unembed_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (148)) + (Prims.of_int (141)) (Prims.of_int (12)) - (Prims.of_int (148)) + (Prims.of_int (141)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (148)) + (Prims.of_int (141)) (Prims.of_int (6)) - (Prims.of_int (150)) + (Prims.of_int (143)) (Prims.of_int (17))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -416,17 +368,17 @@ let rec unembed_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (148)) + (Prims.of_int (141)) (Prims.of_int (12)) - (Prims.of_int (148)) + (Prims.of_int (141)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (148)) + (Prims.of_int (141)) (Prims.of_int (12)) - (Prims.of_int (148)) + (Prims.of_int (141)) (Prims.of_int (35))))) (Obj.magic (u hd)) (fun uu___2 -> @@ -437,17 +389,17 @@ let rec unembed_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (148)) + (Prims.of_int (141)) (Prims.of_int (18)) - (Prims.of_int (148)) + (Prims.of_int (141)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (148)) + (Prims.of_int (141)) (Prims.of_int (12)) - (Prims.of_int (148)) + (Prims.of_int (141)) (Prims.of_int (35))))) (Obj.magic (unembed_list u tl)) @@ -500,12 +452,12 @@ let (extract_fundeps : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (162)) (Prims.of_int (14)) (Prims.of_int (162)) + (Prims.of_int (155)) (Prims.of_int (14)) (Prims.of_int (155)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (162)) (Prims.of_int (32)) (Prims.of_int (176)) + (Prims.of_int (155)) (Prims.of_int (32)) (Prims.of_int (169)) (Prims.of_int (13))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Reflection_V2_Builtins.sigelt_attrs se)) @@ -527,17 +479,17 @@ let (extract_fundeps : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (167)) + (Prims.of_int (160)) (Prims.of_int (12)) - (Prims.of_int (167)) + (Prims.of_int (160)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (167)) + (Prims.of_int (160)) (Prims.of_int (12)) - (Prims.of_int (167)) + (Prims.of_int (160)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_app @@ -583,27 +535,27 @@ let (trywith : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (181)) (Prims.of_int (26)) - (Prims.of_int (181)) (Prims.of_int (122))))) + (Prims.of_int (174)) (Prims.of_int (26)) + (Prims.of_int (174)) (Prims.of_int (122))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (184)) (Prims.of_int (4)) - (Prims.of_int (206)) (Prims.of_int (13))))) + (Prims.of_int (177)) (Prims.of_int (4)) + (Prims.of_int (199)) (Prims.of_int (13))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (181)) (Prims.of_int (26)) - (Prims.of_int (181)) (Prims.of_int (102))))) + (Prims.of_int (174)) (Prims.of_int (26)) + (Prims.of_int (174)) (Prims.of_int (102))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (181)) (Prims.of_int (26)) - (Prims.of_int (181)) (Prims.of_int (122))))) + (Prims.of_int (174)) (Prims.of_int (26)) + (Prims.of_int (174)) (Prims.of_int (122))))) (Obj.magic (FStar_Tactics_Util.mapi (fun uu___1 -> @@ -628,31 +580,31 @@ let (trywith : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (184)) (Prims.of_int (10)) - (Prims.of_int (184)) (Prims.of_int (31))))) + (Prims.of_int (177)) (Prims.of_int (10)) + (Prims.of_int (177)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (184)) (Prims.of_int (4)) - (Prims.of_int (206)) (Prims.of_int (13))))) + (Prims.of_int (177)) (Prims.of_int (4)) + (Prims.of_int (199)) (Prims.of_int (13))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (184)) + (Prims.of_int (177)) (Prims.of_int (18)) - (Prims.of_int (184)) + (Prims.of_int (177)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (184)) + (Prims.of_int (177)) (Prims.of_int (10)) - (Prims.of_int (184)) + (Prims.of_int (177)) (Prims.of_int (31))))) (Obj.magic (res_typ typ)) (fun uu___ -> @@ -668,17 +620,17 @@ let (trywith : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (186)) + (Prims.of_int (179)) (Prims.of_int (6)) - (Prims.of_int (186)) + (Prims.of_int (179)) (Prims.of_int (104))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (187)) + (Prims.of_int (180)) (Prims.of_int (6)) - (Prims.of_int (187)) + (Prims.of_int (180)) (Prims.of_int (18))))) (Obj.magic (debug @@ -688,9 +640,9 @@ let (trywith : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (186)) + (Prims.of_int (179)) (Prims.of_int (53)) - (Prims.of_int (186)) + (Prims.of_int (179)) (Prims.of_int (103))))) (FStar_Sealed.seal (Obj.magic @@ -706,17 +658,17 @@ let (trywith : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (186)) + (Prims.of_int (179)) (Prims.of_int (53)) - (Prims.of_int (186)) + (Prims.of_int (179)) (Prims.of_int (69))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (186)) + (Prims.of_int (179)) (Prims.of_int (53)) - (Prims.of_int (186)) + (Prims.of_int (179)) (Prims.of_int (103))))) (Obj.magic (FStar_Tactics_V2_Builtins.term_to_string @@ -730,9 +682,9 @@ let (trywith : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (186)) + (Prims.of_int (179)) (Prims.of_int (72)) - (Prims.of_int (186)) + (Prims.of_int (179)) (Prims.of_int (103))))) ( FStar_Sealed.seal @@ -750,9 +702,9 @@ let (trywith : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (186)) + (Prims.of_int (179)) (Prims.of_int (85)) - (Prims.of_int (186)) + (Prims.of_int (179)) (Prims.of_int (103))))) (FStar_Sealed.seal (Obj.magic @@ -798,17 +750,17 @@ let (trywith : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (189)) + (Prims.of_int (182)) (Prims.of_int (6)) - (Prims.of_int (190)) + (Prims.of_int (183)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (191)) + (Prims.of_int (184)) (Prims.of_int (6)) - (Prims.of_int (206)) + (Prims.of_int (199)) (Prims.of_int (13))))) (if Prims.op_Negation @@ -826,17 +778,17 @@ let (trywith : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (191)) + (Prims.of_int (184)) (Prims.of_int (6)) - (Prims.of_int (191)) + (Prims.of_int (184)) (Prims.of_int (82))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (192)) + (Prims.of_int (185)) (Prims.of_int (6)) - (Prims.of_int (206)) + (Prims.of_int (199)) (Prims.of_int (13))))) (Obj.magic (debug @@ -847,9 +799,9 @@ let (trywith : ( FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (191)) + (Prims.of_int (184)) (Prims.of_int (65)) - (Prims.of_int (191)) + (Prims.of_int (184)) (Prims.of_int (81))))) (FStar_Sealed.seal (Obj.magic @@ -903,17 +855,17 @@ let (trywith : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (196)) + (Prims.of_int (189)) (Prims.of_int (29)) - (Prims.of_int (196)) + (Prims.of_int (189)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (195)) + (Prims.of_int (188)) (Prims.of_int (62)) - (Prims.of_int (200)) + (Prims.of_int (193)) (Prims.of_int (9))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -935,17 +887,17 @@ let (trywith : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (197)) + (Prims.of_int (190)) (Prims.of_int (10)) - (Prims.of_int (197)) + (Prims.of_int (190)) (Prims.of_int (46))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (197)) + (Prims.of_int (190)) (Prims.of_int (47)) - (Prims.of_int (199)) + (Prims.of_int (192)) (Prims.of_int (54))))) (Obj.magic (debug @@ -969,17 +921,17 @@ let (trywith : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (198)) + (Prims.of_int (191)) (Prims.of_int (25)) - (Prims.of_int (198)) + (Prims.of_int (191)) (Prims.of_int (91))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (199)) + (Prims.of_int (192)) (Prims.of_int (10)) - (Prims.of_int (199)) + (Prims.of_int (192)) (Prims.of_int (54))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -1019,17 +971,17 @@ let (trywith : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (204)) + (Prims.of_int (197)) (Prims.of_int (8)) - (Prims.of_int (204)) + (Prims.of_int (197)) (Prims.of_int (67))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (204)) + (Prims.of_int (197)) (Prims.of_int (68)) - (Prims.of_int (206)) + (Prims.of_int (199)) (Prims.of_int (12))))) (Obj.magic (debug @@ -1040,17 +992,17 @@ let (trywith : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (204)) + (Prims.of_int (197)) (Prims.of_int (25)) - (Prims.of_int (204)) + (Prims.of_int (197)) (Prims.of_int (36))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (204)) + (Prims.of_int (197)) (Prims.of_int (38)) - (Prims.of_int (204)) + (Prims.of_int (197)) (Prims.of_int (66))))) (Obj.magic (FStar_Tactics_V2_Builtins.dump @@ -1071,17 +1023,17 @@ let (trywith : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (205)) + (Prims.of_int (198)) (Prims.of_int (19)) - (Prims.of_int (205)) + (Prims.of_int (198)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (206)) + (Prims.of_int (199)) (Prims.of_int (8)) - (Prims.of_int (206)) + (Prims.of_int (199)) (Prims.of_int (12))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -1120,13 +1072,13 @@ let (local : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (209)) (Prims.of_int (4)) - (Prims.of_int (209)) (Prims.of_int (59))))) + (Prims.of_int (202)) (Prims.of_int (4)) + (Prims.of_int (202)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (209)) (Prims.of_int (60)) - (Prims.of_int (213)) (Prims.of_int (12))))) + (Prims.of_int (202)) (Prims.of_int (60)) + (Prims.of_int (206)) (Prims.of_int (12))))) (Obj.magic (debug (fun uu___1 -> @@ -1135,8 +1087,8 @@ let (local : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (209)) (Prims.of_int (40)) - (Prims.of_int (209)) (Prims.of_int (58))))) + (Prims.of_int (202)) (Prims.of_int (40)) + (Prims.of_int (202)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "prims.fst" @@ -1156,31 +1108,31 @@ let (local : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (210)) (Prims.of_int (13)) - (Prims.of_int (210)) (Prims.of_int (37))))) + (Prims.of_int (203)) (Prims.of_int (13)) + (Prims.of_int (203)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (211)) (Prims.of_int (4)) - (Prims.of_int (213)) (Prims.of_int (12))))) + (Prims.of_int (204)) (Prims.of_int (4)) + (Prims.of_int (206)) (Prims.of_int (12))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (210)) + (Prims.of_int (203)) (Prims.of_int (25)) - (Prims.of_int (210)) + (Prims.of_int (203)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (210)) + (Prims.of_int (203)) (Prims.of_int (13)) - (Prims.of_int (210)) + (Prims.of_int (203)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_env ())) (fun uu___2 -> @@ -1214,13 +1166,13 @@ let (global : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (216)) (Prims.of_int (4)) - (Prims.of_int (216)) (Prims.of_int (60))))) + (Prims.of_int (209)) (Prims.of_int (4)) + (Prims.of_int (209)) (Prims.of_int (60))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (217)) (Prims.of_int (4)) - (Prims.of_int (220)) (Prims.of_int (16))))) + (Prims.of_int (210)) (Prims.of_int (4)) + (Prims.of_int (213)) (Prims.of_int (16))))) (Obj.magic (debug (fun uu___1 -> @@ -1229,8 +1181,8 @@ let (global : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (216)) (Prims.of_int (41)) - (Prims.of_int (216)) (Prims.of_int (59))))) + (Prims.of_int (209)) (Prims.of_int (41)) + (Prims.of_int (209)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "prims.fst" @@ -1254,17 +1206,17 @@ let (global : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (218)) + (Prims.of_int (211)) (Prims.of_int (24)) - (Prims.of_int (218)) + (Prims.of_int (211)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (219)) + (Prims.of_int (212)) (Prims.of_int (14)) - (Prims.of_int (219)) + (Prims.of_int (212)) (Prims.of_int (52))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1272,17 +1224,17 @@ let (global : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (218)) + (Prims.of_int (211)) (Prims.of_int (27)) - (Prims.of_int (218)) + (Prims.of_int (211)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (218)) + (Prims.of_int (211)) (Prims.of_int (24)) - (Prims.of_int (218)) + (Prims.of_int (211)) (Prims.of_int (58))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_env ())) @@ -1319,13 +1271,13 @@ let (try_trivial : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (224)) (Prims.of_int (8)) - (Prims.of_int (224)) (Prims.of_int (11))))) + (Prims.of_int (217)) (Prims.of_int (8)) + (Prims.of_int (217)) (Prims.of_int (11))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (224)) (Prims.of_int (2)) - (Prims.of_int (229)) (Prims.of_int (19))))) + (Prims.of_int (217)) (Prims.of_int (2)) + (Prims.of_int (222)) (Prims.of_int (19))))) (Obj.magic (FStar_Tactics_NamedView.inspect g.g)) (fun uu___1 -> (fun uu___1 -> @@ -1364,12 +1316,12 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (241)) (Prims.of_int (4)) (Prims.of_int (242)) + (Prims.of_int (234)) (Prims.of_int (4)) (Prims.of_int (235)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (243)) (Prims.of_int (4)) (Prims.of_int (272)) + (Prims.of_int (236)) (Prims.of_int (4)) (Prims.of_int (265)) (Prims.of_int (33))))) (if st.fuel <= Prims.int_zero then FStar_Tactics_Effect.raise NoInst @@ -1381,13 +1333,13 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (243)) (Prims.of_int (4)) - (Prims.of_int (243)) (Prims.of_int (55))))) + (Prims.of_int (236)) (Prims.of_int (4)) + (Prims.of_int (236)) (Prims.of_int (55))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (245)) (Prims.of_int (4)) - (Prims.of_int (272)) (Prims.of_int (33))))) + (Prims.of_int (238)) (Prims.of_int (4)) + (Prims.of_int (265)) (Prims.of_int (33))))) (Obj.magic (debug (fun uu___1 -> @@ -1406,14 +1358,14 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (245)) (Prims.of_int (4)) - (Prims.of_int (245)) (Prims.of_int (18))))) + (Prims.of_int (238)) (Prims.of_int (4)) + (Prims.of_int (238)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (245)) (Prims.of_int (19)) - (Prims.of_int (272)) (Prims.of_int (33))))) + (Prims.of_int (238)) (Prims.of_int (19)) + (Prims.of_int (265)) (Prims.of_int (33))))) (Obj.magic (maybe_intros ())) (fun uu___2 -> (fun uu___2 -> @@ -1423,17 +1375,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (246)) + (Prims.of_int (239)) (Prims.of_int (12)) - (Prims.of_int (246)) + (Prims.of_int (239)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (249)) + (Prims.of_int (242)) (Prims.of_int (4)) - (Prims.of_int (272)) + (Prims.of_int (265)) (Prims.of_int (33))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_goal @@ -1446,17 +1398,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (249)) + (Prims.of_int (242)) (Prims.of_int (4)) - (Prims.of_int (252)) + (Prims.of_int (245)) (Prims.of_int (5))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (254)) + (Prims.of_int (247)) (Prims.of_int (4)) - (Prims.of_int (272)) + (Prims.of_int (265)) (Prims.of_int (33))))) (if FStar_List_Tot_Base.existsb @@ -1470,17 +1422,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (250)) + (Prims.of_int (243)) (Prims.of_int (6)) - (Prims.of_int (250)) + (Prims.of_int (243)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (251)) + (Prims.of_int (244)) (Prims.of_int (6)) - (Prims.of_int (251)) + (Prims.of_int (244)) (Prims.of_int (18))))) (Obj.magic (debug @@ -1511,20 +1463,21 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (254)) + (Prims.of_int (247)) (Prims.of_int (10)) - (Prims.of_int (254)) + (Prims.of_int (247)) (Prims.of_int (15))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (254)) + (Prims.of_int (247)) (Prims.of_int (4)) - (Prims.of_int (272)) + (Prims.of_int (265)) (Prims.of_int (33))))) (Obj.magic - (hua g)) + (FStar_Tactics_V2_SyntaxHelpers.hua + g)) (fun uu___4 -> (fun uu___4 -> @@ -1539,17 +1492,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (256)) + (Prims.of_int (249)) (Prims.of_int (6)) - (Prims.of_int (256)) + (Prims.of_int (249)) (Prims.of_int (61))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (257)) + (Prims.of_int (250)) (Prims.of_int (6)) - (Prims.of_int (257)) + (Prims.of_int (250)) (Prims.of_int (18))))) (Obj.magic (debug @@ -1578,17 +1531,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (261)) + (Prims.of_int (254)) (Prims.of_int (17)) - (Prims.of_int (261)) + (Prims.of_int (254)) (Prims.of_int (61))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (261)) + (Prims.of_int (254)) (Prims.of_int (64)) - (Prims.of_int (272)) + (Prims.of_int (265)) (Prims.of_int (33))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1596,17 +1549,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (261)) + (Prims.of_int (254)) (Prims.of_int (28)) - (Prims.of_int (261)) + (Prims.of_int (254)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (261)) + (Prims.of_int (254)) (Prims.of_int (17)) - (Prims.of_int (261)) + (Prims.of_int (254)) (Prims.of_int (61))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_env @@ -1630,17 +1583,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (262)) + (Prims.of_int (255)) (Prims.of_int (20)) - (Prims.of_int (264)) + (Prims.of_int (257)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (265)) + (Prims.of_int (258)) (Prims.of_int (8)) - (Prims.of_int (272)) + (Prims.of_int (265)) (Prims.of_int (33))))) (match c_se with @@ -1671,17 +1624,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (267)) + (Prims.of_int (260)) (Prims.of_int (27)) - (Prims.of_int (267)) + (Prims.of_int (260)) (Prims.of_int (89))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (267)) + (Prims.of_int (260)) (Prims.of_int (92)) - (Prims.of_int (272)) + (Prims.of_int (265)) (Prims.of_int (33))))) (Obj.magic (FStar_Tactics_Util.map @@ -1696,17 +1649,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (267)) + (Prims.of_int (260)) (Prims.of_int (67)) - (Prims.of_int (267)) + (Prims.of_int (260)) (Prims.of_int (88))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (267)) + (Prims.of_int (260)) (Prims.of_int (59)) - (Prims.of_int (267)) + (Prims.of_int (260)) (Prims.of_int (88))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1714,17 +1667,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (267)) + (Prims.of_int (260)) (Prims.of_int (73)) - (Prims.of_int (267)) + (Prims.of_int (260)) (Prims.of_int (88))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (267)) + (Prims.of_int (260)) (Prims.of_int (67)) - (Prims.of_int (267)) + (Prims.of_int (260)) (Prims.of_int (88))))) (Obj.magic (FStar_Tactics_V2_Builtins.free_uvars @@ -1755,17 +1708,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (268)) + (Prims.of_int (261)) (Prims.of_int (17)) - (Prims.of_int (268)) + (Prims.of_int (261)) (Prims.of_int (44))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (268)) + (Prims.of_int (261)) (Prims.of_int (49)) - (Prims.of_int (272)) + (Prims.of_int (265)) (Prims.of_int (33))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -1789,17 +1742,17 @@ let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (269)) + (Prims.of_int (262)) (Prims.of_int (16)) - (Prims.of_int (269)) + (Prims.of_int (262)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (270)) + (Prims.of_int (263)) (Prims.of_int (6)) - (Prims.of_int (272)) + (Prims.of_int (265)) (Prims.of_int (33))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -1858,14 +1811,14 @@ let rec concatMap : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (277)) (Prims.of_int (13)) - (Prims.of_int (277)) (Prims.of_int (16))))) + (Prims.of_int (270)) (Prims.of_int (13)) + (Prims.of_int (270)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (277)) (Prims.of_int (13)) - (Prims.of_int (277)) (Prims.of_int (33))))) + (Prims.of_int (270)) (Prims.of_int (13)) + (Prims.of_int (270)) (Prims.of_int (33))))) (Obj.magic (f x)) (fun uu___ -> (fun uu___ -> @@ -1875,17 +1828,17 @@ let rec concatMap : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (277)) + (Prims.of_int (270)) (Prims.of_int (19)) - (Prims.of_int (277)) + (Prims.of_int (270)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (277)) + (Prims.of_int (270)) (Prims.of_int (13)) - (Prims.of_int (277)) + (Prims.of_int (270)) (Prims.of_int (33))))) (Obj.magic (concatMap f xs)) (fun uu___1 -> @@ -1898,12 +1851,12 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (282)) (Prims.of_int (4)) (Prims.of_int (282)) + (Prims.of_int (275)) (Prims.of_int (4)) (Prims.of_int (275)) (Prims.of_int (54))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (282)) (Prims.of_int (55)) (Prims.of_int (315)) + (Prims.of_int (275)) (Prims.of_int (55)) (Prims.of_int (308)) (Prims.of_int (18))))) (Obj.magic (debug @@ -1912,13 +1865,13 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (282)) (Prims.of_int (21)) - (Prims.of_int (282)) (Prims.of_int (28))))) + (Prims.of_int (275)) (Prims.of_int (21)) + (Prims.of_int (275)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (282)) (Prims.of_int (30)) - (Prims.of_int (282)) (Prims.of_int (53))))) + (Prims.of_int (275)) (Prims.of_int (30)) + (Prims.of_int (275)) (Prims.of_int (53))))) (Obj.magic (FStar_Tactics_V2_Builtins.dump "")) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -1930,13 +1883,13 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (283)) (Prims.of_int (12)) - (Prims.of_int (283)) (Prims.of_int (26))))) + (Prims.of_int (276)) (Prims.of_int (12)) + (Prims.of_int (276)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (284)) (Prims.of_int (4)) - (Prims.of_int (315)) (Prims.of_int (18))))) + (Prims.of_int (277)) (Prims.of_int (4)) + (Prims.of_int (308)) (Prims.of_int (18))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_witness ())) (fun uu___2 -> (fun w -> @@ -1946,14 +1899,14 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (284)) (Prims.of_int (4)) - (Prims.of_int (284)) (Prims.of_int (29))))) + (Prims.of_int (277)) (Prims.of_int (4)) + (Prims.of_int (277)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (287)) (Prims.of_int (4)) - (Prims.of_int (315)) (Prims.of_int (18))))) + (Prims.of_int (280)) (Prims.of_int (4)) + (Prims.of_int (308)) (Prims.of_int (18))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_dump_on_failure false)) @@ -1965,17 +1918,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (287)) + (Prims.of_int (280)) (Prims.of_int (4)) - (Prims.of_int (287)) + (Prims.of_int (280)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (287)) + (Prims.of_int (280)) (Prims.of_int (20)) - (Prims.of_int (315)) + (Prims.of_int (308)) (Prims.of_int (18))))) (Obj.magic (maybe_intros ())) (fun uu___3 -> @@ -1986,17 +1939,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (292)) + (Prims.of_int (285)) (Prims.of_int (14)) - (Prims.of_int (292)) + (Prims.of_int (285)) (Prims.of_int (56))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (292)) + (Prims.of_int (285)) (Prims.of_int (59)) - (Prims.of_int (315)) + (Prims.of_int (308)) (Prims.of_int (18))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2004,17 +1957,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (292)) + (Prims.of_int (285)) (Prims.of_int (44)) - (Prims.of_int (292)) + (Prims.of_int (285)) (Prims.of_int (56))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (292)) + (Prims.of_int (285)) (Prims.of_int (14)) - (Prims.of_int (292)) + (Prims.of_int (285)) (Prims.of_int (56))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_env @@ -2039,17 +1992,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (293)) + (Prims.of_int (286)) (Prims.of_int (14)) - (Prims.of_int (295)) + (Prims.of_int (288)) (Prims.of_int (5))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (296)) + (Prims.of_int (289)) (Prims.of_int (6)) - (Prims.of_int (315)) + (Prims.of_int (308)) (Prims.of_int (18))))) (Obj.magic (concatMap @@ -2076,17 +2029,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (298)) + (Prims.of_int (291)) (Prims.of_int (6)) - (Prims.of_int (300)) + (Prims.of_int (293)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (302)) + (Prims.of_int (295)) (Prims.of_int (4)) - (Prims.of_int (315)) + (Prims.of_int (308)) (Prims.of_int (18))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2115,17 +2068,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (303)) + (Prims.of_int (296)) (Prims.of_int (6)) - (Prims.of_int (303)) + (Prims.of_int (296)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (304)) + (Prims.of_int (297)) (Prims.of_int (6)) - (Prims.of_int (304)) + (Prims.of_int (297)) (Prims.of_int (59))))) (Obj.magic (tcresolve' @@ -2143,9 +2096,9 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (304)) + (Prims.of_int (297)) (Prims.of_int (42)) - (Prims.of_int (304)) + (Prims.of_int (297)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic @@ -2182,17 +2135,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (308)) + (Prims.of_int (301)) (Prims.of_int (15)) - (Prims.of_int (312)) + (Prims.of_int (305)) (Prims.of_int (7))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (308)) + (Prims.of_int (301)) (Prims.of_int (6)) - (Prims.of_int (312)) + (Prims.of_int (305)) (Prims.of_int (7))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2200,17 +2153,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (308)) + (Prims.of_int (301)) (Prims.of_int (15)) - (Prims.of_int (312)) + (Prims.of_int (305)) (Prims.of_int (7))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (308)) + (Prims.of_int (301)) (Prims.of_int (15)) - (Prims.of_int (312)) + (Prims.of_int (305)) (Prims.of_int (7))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2218,17 +2171,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (310)) + (Prims.of_int (303)) (Prims.of_int (8)) - (Prims.of_int (311)) + (Prims.of_int (304)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (308)) + (Prims.of_int (301)) (Prims.of_int (15)) - (Prims.of_int (312)) + (Prims.of_int (305)) (Prims.of_int (7))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2236,17 +2189,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (311)) + (Prims.of_int (304)) (Prims.of_int (10)) - (Prims.of_int (311)) + (Prims.of_int (304)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (310)) + (Prims.of_int (303)) (Prims.of_int (8)) - (Prims.of_int (311)) + (Prims.of_int (304)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2254,17 +2207,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (311)) + (Prims.of_int (304)) (Prims.of_int (23)) - (Prims.of_int (311)) + (Prims.of_int (304)) (Prims.of_int (36))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (311)) + (Prims.of_int (304)) (Prims.of_int (10)) - (Prims.of_int (311)) + (Prims.of_int (304)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_goal @@ -2363,8 +2316,8 @@ let rec (mk_abs : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (324)) (Prims.of_int (20)) - (Prims.of_int (324)) (Prims.of_int (47))))) + (Prims.of_int (317)) (Prims.of_int (20)) + (Prims.of_int (317)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "dummy" Prims.int_zero @@ -2375,17 +2328,17 @@ let rec (mk_abs : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (324)) + (Prims.of_int (317)) (Prims.of_int (30)) - (Prims.of_int (324)) + (Prims.of_int (317)) (Prims.of_int (46))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (324)) + (Prims.of_int (317)) (Prims.of_int (20)) - (Prims.of_int (324)) + (Prims.of_int (317)) (Prims.of_int (47))))) (Obj.magic (mk_abs bs1 body)) (fun uu___ -> @@ -2444,12 +2397,12 @@ let (mk_class : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (348)) (Prims.of_int (13)) (Prims.of_int (348)) + (Prims.of_int (341)) (Prims.of_int (13)) (Prims.of_int (341)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (348)) (Prims.of_int (29)) (Prims.of_int (438)) + (Prims.of_int (341)) (Prims.of_int (29)) (Prims.of_int (431)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Reflection_V2_Builtins.explode_qn nm)) @@ -2460,27 +2413,27 @@ let (mk_class : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (349)) (Prims.of_int (12)) - (Prims.of_int (349)) (Prims.of_int (38))))) + (Prims.of_int (342)) (Prims.of_int (12)) + (Prims.of_int (342)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (350)) (Prims.of_int (4)) - (Prims.of_int (438)) (Prims.of_int (5))))) + (Prims.of_int (343)) (Prims.of_int (4)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (349)) (Prims.of_int (23)) - (Prims.of_int (349)) (Prims.of_int (35))))) + (Prims.of_int (342)) (Prims.of_int (23)) + (Prims.of_int (342)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (349)) (Prims.of_int (12)) - (Prims.of_int (349)) (Prims.of_int (38))))) + (Prims.of_int (342)) (Prims.of_int (12)) + (Prims.of_int (342)) (Prims.of_int (38))))) (Obj.magic (FStar_Tactics_V2_Builtins.top_env ())) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac @@ -2495,14 +2448,14 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (350)) (Prims.of_int (4)) - (Prims.of_int (350)) (Prims.of_int (19))))) + (Prims.of_int (343)) (Prims.of_int (4)) + (Prims.of_int (343)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (350)) (Prims.of_int (20)) - (Prims.of_int (438)) (Prims.of_int (5))))) + (Prims.of_int (343)) (Prims.of_int (20)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard (FStar_Pervasives_Native.uu___is_Some r))) @@ -2514,17 +2467,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (351)) + (Prims.of_int (344)) (Prims.of_int (18)) - (Prims.of_int (351)) + (Prims.of_int (344)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (350)) + (Prims.of_int (343)) (Prims.of_int (20)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> r)) @@ -2539,17 +2492,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (352)) + (Prims.of_int (345)) (Prims.of_int (23)) - (Prims.of_int (352)) + (Prims.of_int (345)) (Prims.of_int (115))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (352)) + (Prims.of_int (345)) (Prims.of_int (118)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> @@ -2574,18 +2527,18 @@ let (mk_class : Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (353)) + (Prims.of_int (346)) (Prims.of_int (13)) - (Prims.of_int (353)) + (Prims.of_int (346)) (Prims.of_int (30))))) (FStar_Sealed.seal ( Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (354)) + (Prims.of_int (347)) (Prims.of_int (4)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic ( @@ -2601,17 +2554,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (354)) + (Prims.of_int (347)) (Prims.of_int (4)) - (Prims.of_int (354)) + (Prims.of_int (347)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (354)) + (Prims.of_int (347)) (Prims.of_int (29)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard @@ -2627,17 +2580,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (355)) + (Prims.of_int (348)) (Prims.of_int (63)) - (Prims.of_int (355)) + (Prims.of_int (348)) (Prims.of_int (65))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (354)) + (Prims.of_int (347)) (Prims.of_int (29)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2669,17 +2622,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (356)) + (Prims.of_int (349)) (Prims.of_int (4)) - (Prims.of_int (356)) + (Prims.of_int (349)) (Prims.of_int (87))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (357)) + (Prims.of_int (350)) (Prims.of_int (4)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2690,9 +2643,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (356)) + (Prims.of_int (349)) (Prims.of_int (35)) - (Prims.of_int (356)) + (Prims.of_int (349)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -2724,17 +2677,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (357)) + (Prims.of_int (350)) (Prims.of_int (4)) - (Prims.of_int (357)) + (Prims.of_int (350)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (358)) + (Prims.of_int (351)) (Prims.of_int (4)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2761,17 +2714,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (358)) + (Prims.of_int (351)) (Prims.of_int (4)) - (Prims.of_int (358)) + (Prims.of_int (351)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (358)) + (Prims.of_int (351)) (Prims.of_int (60)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2782,9 +2735,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (358)) + (Prims.of_int (351)) (Prims.of_int (40)) - (Prims.of_int (358)) + (Prims.of_int (351)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic @@ -2815,17 +2768,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (359)) + (Prims.of_int (352)) (Prims.of_int (20)) - (Prims.of_int (359)) + (Prims.of_int (352)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (361)) + (Prims.of_int (354)) (Prims.of_int (4)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (last @@ -2841,17 +2794,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (361)) + (Prims.of_int (354)) (Prims.of_int (4)) - (Prims.of_int (361)) + (Prims.of_int (354)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (361)) + (Prims.of_int (354)) (Prims.of_int (31)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard @@ -2868,17 +2821,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (362)) + (Prims.of_int (355)) (Prims.of_int (25)) - (Prims.of_int (362)) + (Prims.of_int (355)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (361)) + (Prims.of_int (354)) (Prims.of_int (31)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2900,17 +2853,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (363)) + (Prims.of_int (356)) (Prims.of_int (4)) - (Prims.of_int (363)) + (Prims.of_int (356)) (Prims.of_int (87))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (363)) + (Prims.of_int (356)) (Prims.of_int (88)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2921,9 +2874,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (363)) + (Prims.of_int (356)) (Prims.of_int (35)) - (Prims.of_int (363)) + (Prims.of_int (356)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -2939,9 +2892,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (363)) + (Prims.of_int (356)) (Prims.of_int (55)) - (Prims.of_int (363)) + (Prims.of_int (356)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -2957,9 +2910,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (363)) + (Prims.of_int (356)) (Prims.of_int (69)) - (Prims.of_int (363)) + (Prims.of_int (356)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -3013,17 +2966,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (364)) + (Prims.of_int (357)) (Prims.of_int (18)) - (Prims.of_int (364)) + (Prims.of_int (357)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (363)) + (Prims.of_int (356)) (Prims.of_int (88)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_arr_bs @@ -3045,17 +2998,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (365)) + (Prims.of_int (358)) (Prims.of_int (12)) - (Prims.of_int (365)) + (Prims.of_int (358)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (366)) + (Prims.of_int (359)) (Prims.of_int (4)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3074,17 +3027,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (366)) + (Prims.of_int (359)) (Prims.of_int (4)) - (Prims.of_int (366)) + (Prims.of_int (359)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (366)) + (Prims.of_int (359)) (Prims.of_int (23)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard @@ -3102,17 +3055,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (367)) + (Prims.of_int (360)) (Prims.of_int (22)) - (Prims.of_int (367)) + (Prims.of_int (360)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (366)) + (Prims.of_int (359)) (Prims.of_int (23)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3135,17 +3088,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (369)) + (Prims.of_int (362)) (Prims.of_int (4)) - (Prims.of_int (369)) + (Prims.of_int (362)) (Prims.of_int (87))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (370)) + (Prims.of_int (363)) (Prims.of_int (4)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (debug @@ -3157,9 +3110,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (369)) + (Prims.of_int (362)) (Prims.of_int (35)) - (Prims.of_int (369)) + (Prims.of_int (362)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -3195,17 +3148,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (370)) + (Prims.of_int (363)) (Prims.of_int (4)) - (Prims.of_int (370)) + (Prims.of_int (363)) (Prims.of_int (81))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (371)) + (Prims.of_int (364)) (Prims.of_int (4)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (debug @@ -3238,17 +3191,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (371)) + (Prims.of_int (364)) (Prims.of_int (4)) - (Prims.of_int (371)) + (Prims.of_int (364)) (Prims.of_int (76))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (372)) + (Prims.of_int (365)) (Prims.of_int (4)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (debug @@ -3281,17 +3234,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (372)) + (Prims.of_int (365)) (Prims.of_int (4)) - (Prims.of_int (372)) + (Prims.of_int (365)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (372)) + (Prims.of_int (365)) (Prims.of_int (52)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (debug @@ -3303,9 +3256,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (372)) + (Prims.of_int (365)) (Prims.of_int (32)) - (Prims.of_int (372)) + (Prims.of_int (365)) (Prims.of_int (50))))) (FStar_Sealed.seal (Obj.magic @@ -3340,17 +3293,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (376)) + (Prims.of_int (369)) (Prims.of_int (24)) - (Prims.of_int (376)) + (Prims.of_int (369)) (Prims.of_int (61))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (379)) + (Prims.of_int (372)) (Prims.of_int (4)) - (Prims.of_int (438)) + (Prims.of_int (431)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3374,17 +3327,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (381)) + (Prims.of_int (374)) (Prims.of_int (14)) - (Prims.of_int (381)) + (Prims.of_int (374)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (382)) + (Prims.of_int (375)) (Prims.of_int (6)) - (Prims.of_int (437)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_V2_Derived.name_of_binder @@ -3399,17 +3352,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (382)) + (Prims.of_int (375)) (Prims.of_int (6)) - (Prims.of_int (382)) + (Prims.of_int (375)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (382)) + (Prims.of_int (375)) (Prims.of_int (49)) - (Prims.of_int (437)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (debug @@ -3440,17 +3393,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (383)) + (Prims.of_int (376)) (Prims.of_int (15)) - (Prims.of_int (383)) + (Prims.of_int (376)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (383)) + (Prims.of_int (376)) (Prims.of_int (31)) - (Prims.of_int (437)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_module @@ -3466,17 +3419,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (384)) + (Prims.of_int (377)) (Prims.of_int (16)) - (Prims.of_int (384)) + (Prims.of_int (377)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (384)) + (Prims.of_int (377)) (Prims.of_int (37)) - (Prims.of_int (437)) + (Prims.of_int (430)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3497,17 +3450,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (385)) + (Prims.of_int (378)) (Prims.of_int (16)) - (Prims.of_int (385)) + (Prims.of_int (378)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (385)) + (Prims.of_int (378)) (Prims.of_int (41)) - (Prims.of_int (437)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_V2_Derived.fresh_namedv_named @@ -3523,17 +3476,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (386)) + (Prims.of_int (379)) (Prims.of_int (16)) - (Prims.of_int (386)) + (Prims.of_int (379)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (386)) + (Prims.of_int (379)) (Prims.of_int (31)) - (Prims.of_int (437)) + (Prims.of_int (430)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3557,17 +3510,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (388)) + (Prims.of_int (381)) (Prims.of_int (8)) - (Prims.of_int (392)) + (Prims.of_int (385)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (393)) + (Prims.of_int (386)) (Prims.of_int (10)) - (Prims.of_int (437)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3575,17 +3528,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (390)) + (Prims.of_int (383)) (Prims.of_int (17)) - (Prims.of_int (390)) + (Prims.of_int (383)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (388)) + (Prims.of_int (381)) (Prims.of_int (8)) - (Prims.of_int (392)) + (Prims.of_int (385)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V2_Builtins.fresh @@ -3624,17 +3577,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (394)) + (Prims.of_int (387)) (Prims.of_int (22)) - (Prims.of_int (394)) + (Prims.of_int (387)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (394)) + (Prims.of_int (387)) (Prims.of_int (51)) - (Prims.of_int (437)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3642,17 +3595,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (394)) + (Prims.of_int (387)) (Prims.of_int (22)) - (Prims.of_int (394)) + (Prims.of_int (387)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (394)) + (Prims.of_int (387)) (Prims.of_int (22)) - (Prims.of_int (394)) + (Prims.of_int (387)) (Prims.of_int (48))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_module @@ -3681,17 +3634,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (395)) + (Prims.of_int (388)) (Prims.of_int (17)) - (Prims.of_int (395)) + (Prims.of_int (388)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (395)) + (Prims.of_int (388)) (Prims.of_int (54)) - (Prims.of_int (437)) + (Prims.of_int (430)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3712,17 +3665,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (398)) + (Prims.of_int (391)) (Prims.of_int (8)) - (Prims.of_int (403)) + (Prims.of_int (396)) (Prims.of_int (50))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (404)) + (Prims.of_int (397)) (Prims.of_int (8)) - (Prims.of_int (437)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3730,17 +3683,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (398)) + (Prims.of_int (391)) (Prims.of_int (14)) - (Prims.of_int (398)) + (Prims.of_int (391)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (398)) + (Prims.of_int (391)) (Prims.of_int (8)) - (Prims.of_int (403)) + (Prims.of_int (396)) (Prims.of_int (50))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3748,17 +3701,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (398)) + (Prims.of_int (391)) (Prims.of_int (25)) - (Prims.of_int (398)) + (Prims.of_int (391)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (398)) + (Prims.of_int (391)) (Prims.of_int (14)) - (Prims.of_int (398)) + (Prims.of_int (391)) (Prims.of_int (47))))) (Obj.magic (FStar_Tactics_V2_Builtins.top_env @@ -3798,17 +3751,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (401)) + (Prims.of_int (394)) (Prims.of_int (16)) - (Prims.of_int (401)) + (Prims.of_int (394)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (401)) + (Prims.of_int (394)) (Prims.of_int (10)) - (Prims.of_int (403)) + (Prims.of_int (396)) (Prims.of_int (50))))) (Obj.magic (FStar_Tactics_NamedView.inspect_sigelt @@ -3855,17 +3808,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (407)) + (Prims.of_int (400)) (Prims.of_int (14)) - (Prims.of_int (414)) + (Prims.of_int (407)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (415)) + (Prims.of_int (408)) (Prims.of_int (8)) - (Prims.of_int (437)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3873,17 +3826,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (408)) + (Prims.of_int (401)) (Prims.of_int (22)) - (Prims.of_int (408)) + (Prims.of_int (401)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (407)) + (Prims.of_int (400)) (Prims.of_int (14)) - (Prims.of_int (414)) + (Prims.of_int (407)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_arr_bs @@ -3905,17 +3858,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (409)) + (Prims.of_int (402)) (Prims.of_int (21)) - (Prims.of_int (409)) + (Prims.of_int (402)) (Prims.of_int (75))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (408)) + (Prims.of_int (401)) (Prims.of_int (54)) - (Prims.of_int (414)) + (Prims.of_int (407)) (Prims.of_int (37))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3954,17 +3907,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (413)) + (Prims.of_int (406)) (Prims.of_int (21)) - (Prims.of_int (413)) + (Prims.of_int (406)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (414)) + (Prims.of_int (407)) (Prims.of_int (12)) - (Prims.of_int (414)) + (Prims.of_int (407)) (Prims.of_int (37))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3998,17 +3951,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (416)) + (Prims.of_int (409)) (Prims.of_int (15)) - (Prims.of_int (423)) + (Prims.of_int (416)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (425)) + (Prims.of_int (418)) (Prims.of_int (6)) - (Prims.of_int (437)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -4016,17 +3969,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (417)) + (Prims.of_int (410)) (Prims.of_int (23)) - (Prims.of_int (417)) + (Prims.of_int (410)) (Prims.of_int (49))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (416)) + (Prims.of_int (409)) (Prims.of_int (15)) - (Prims.of_int (423)) + (Prims.of_int (416)) (Prims.of_int (38))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_abs @@ -4048,17 +4001,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (418)) + (Prims.of_int (411)) (Prims.of_int (21)) - (Prims.of_int (418)) + (Prims.of_int (411)) (Prims.of_int (75))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (417)) + (Prims.of_int (410)) (Prims.of_int (52)) - (Prims.of_int (423)) + (Prims.of_int (416)) (Prims.of_int (38))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -4097,17 +4050,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (422)) + (Prims.of_int (415)) (Prims.of_int (21)) - (Prims.of_int (422)) + (Prims.of_int (415)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (423)) + (Prims.of_int (416)) (Prims.of_int (12)) - (Prims.of_int (423)) + (Prims.of_int (416)) (Prims.of_int (38))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -4141,17 +4094,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (425)) + (Prims.of_int (418)) (Prims.of_int (6)) - (Prims.of_int (425)) + (Prims.of_int (418)) (Prims.of_int (53))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (426)) + (Prims.of_int (419)) (Prims.of_int (6)) - (Prims.of_int (437)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (debug @@ -4163,9 +4116,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (425)) + (Prims.of_int (418)) (Prims.of_int (34)) - (Prims.of_int (425)) + (Prims.of_int (418)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic @@ -4200,17 +4153,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (426)) + (Prims.of_int (419)) (Prims.of_int (6)) - (Prims.of_int (426)) + (Prims.of_int (419)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (426)) + (Prims.of_int (419)) (Prims.of_int (53)) - (Prims.of_int (437)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (debug @@ -4222,9 +4175,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (426)) + (Prims.of_int (419)) (Prims.of_int (34)) - (Prims.of_int (426)) + (Prims.of_int (419)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic @@ -4259,17 +4212,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (428)) + (Prims.of_int (421)) (Prims.of_int (22)) - (Prims.of_int (428)) + (Prims.of_int (421)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (428)) + (Prims.of_int (421)) (Prims.of_int (27)) - (Prims.of_int (437)) + (Prims.of_int (430)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -4286,17 +4239,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (429)) + (Prims.of_int (422)) (Prims.of_int (23)) - (Prims.of_int (429)) + (Prims.of_int (422)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (429)) + (Prims.of_int (422)) (Prims.of_int (29)) - (Prims.of_int (437)) + (Prims.of_int (430)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -4313,17 +4266,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (430)) + (Prims.of_int (423)) (Prims.of_int (21)) - (Prims.of_int (430)) + (Prims.of_int (423)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (430)) + (Prims.of_int (423)) (Prims.of_int (27)) - (Prims.of_int (437)) + (Prims.of_int (430)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -4340,17 +4293,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (432)) + (Prims.of_int (425)) (Prims.of_int (17)) - (Prims.of_int (432)) + (Prims.of_int (425)) (Prims.of_int (70))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (432)) + (Prims.of_int (425)) (Prims.of_int (75)) - (Prims.of_int (437)) + (Prims.of_int (430)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -4378,17 +4331,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (433)) + (Prims.of_int (426)) (Prims.of_int (15)) - (Prims.of_int (433)) + (Prims.of_int (426)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (435)) + (Prims.of_int (428)) (Prims.of_int (15)) - (Prims.of_int (435)) + (Prims.of_int (428)) (Prims.of_int (42))))) (Obj.magic (FStar_Tactics_NamedView.pack_sigelt diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Types.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Types.ml index 895b39e158b..64867e95d86 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Types.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Types.ml @@ -35,6 +35,7 @@ type guard_policy = | SMT | SMTSync | Force + | ForceSMT | Drop let (uu___is_Goal : guard_policy -> Prims.bool) = fun projectee -> match projectee with | Goal -> true | uu___ -> false @@ -44,6 +45,8 @@ let (uu___is_SMTSync : guard_policy -> Prims.bool) = fun projectee -> match projectee with | SMTSync -> true | uu___ -> false let (uu___is_Force : guard_policy -> Prims.bool) = fun projectee -> match projectee with | Force -> true | uu___ -> false +let (uu___is_ForceSMT : guard_policy -> Prims.bool) = + fun projectee -> match projectee with | ForceSMT -> true | uu___ -> false let (uu___is_Drop : guard_policy -> Prims.bool) = fun projectee -> match projectee with | Drop -> true | uu___ -> false type proofstate = diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml index cf039004dd6..f3f4913f81a 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml @@ -604,6 +604,66 @@ let (proc_guard_formula : FStar_Tactics_Monad.monad_tac () (Obj.repr ())) () with + | uu___1 -> + FStar_Tactics_Monad.mlog + (fun uu___2 -> + let uu___3 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + f in + FStar_Compiler_Util.print1 + "guard = %s\n" uu___3) + (fun uu___2 -> + fail1 + "Forcing the guard failed (%s)" + reason))) + | FStar_Tactics_Types.ForceSMT -> + Obj.magic + (FStar_Tactics_Monad.mlog + (fun uu___ -> + let uu___1 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term f in + FStar_Compiler_Util.print2 + "Forcing guard WITH SMT (%s:%s)\n" reason + uu___1) + (fun uu___ -> + let g = + { + FStar_TypeChecker_Common.guard_f = + (FStar_TypeChecker_Common.NonTrivial f); + FStar_TypeChecker_Common.deferred_to_tac + = + (FStar_TypeChecker_Env.trivial_guard.FStar_TypeChecker_Common.deferred_to_tac); + FStar_TypeChecker_Common.deferred = + (FStar_TypeChecker_Env.trivial_guard.FStar_TypeChecker_Common.deferred); + FStar_TypeChecker_Common.univ_ineqs = + (FStar_TypeChecker_Env.trivial_guard.FStar_TypeChecker_Common.univ_ineqs); + FStar_TypeChecker_Common.implicits = + (FStar_TypeChecker_Env.trivial_guard.FStar_TypeChecker_Common.implicits) + } in + try + (fun uu___1 -> + match () with + | () -> + let uu___2 = + let uu___3 = + let uu___4 = + FStar_TypeChecker_Rel.discharge_guard + e g in + FStar_TypeChecker_Env.is_trivial + uu___4 in + Prims.op_Negation uu___3 in + if uu___2 + then + fail1 + "Forcing the guard failed (%s)" + reason + else + FStar_Class_Monad.return + FStar_Tactics_Monad.monad_tac () + (Obj.repr ())) () + with | uu___1 -> FStar_Tactics_Monad.mlog (fun uu___2 -> @@ -3269,84 +3329,119 @@ let (norm : let uu___2 = FStar_Tactics_Monad.goal_with_type goal t in Obj.magic (FStar_Tactics_Monad.replace_cur uu___2)) uu___1))) uu___) +let (__norm_term_env : + Prims.bool -> + env -> + FStar_Pervasives.norm_step Prims.list -> + FStar_Syntax_Syntax.term -> + FStar_Syntax_Syntax.term FStar_Tactics_Monad.tac) + = + fun well_typed -> + fun e -> + fun s -> + fun t -> + let uu___ = + Obj.magic + (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () + () (Obj.magic FStar_Tactics_Monad.get) + (fun uu___1 -> + (fun ps -> + let ps = Obj.magic ps in + let uu___1 = + FStar_Tactics_Monad.if_verbose + (fun uu___2 -> + let uu___3 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in + FStar_Compiler_Util.print1 + "norm_term_env: t = %s\n" uu___3) in + Obj.magic + (FStar_Class_Monad.op_let_Bang + FStar_Tactics_Monad.monad_tac () () uu___1 + (fun uu___2 -> + (fun uu___2 -> + let uu___2 = Obj.magic uu___2 in + let uu___3 = + if well_typed + then + Obj.magic + (FStar_Class_Monad.return + FStar_Tactics_Monad.monad_tac () + (Obj.magic t)) + else + (let uu___5 = __tc_lax e t in + Obj.magic + (FStar_Class_Monad.op_let_Bang + FStar_Tactics_Monad.monad_tac () + () (Obj.magic uu___5) + (fun uu___6 -> + (fun uu___6 -> + let uu___6 = + Obj.magic uu___6 in + match uu___6 with + | (t1, uu___7, uu___8) -> + Obj.magic + (FStar_Class_Monad.return + FStar_Tactics_Monad.monad_tac + () (Obj.magic t1))) + uu___6))) in + Obj.magic + (FStar_Class_Monad.op_let_Bang + FStar_Tactics_Monad.monad_tac () () + (Obj.magic uu___3) + (fun uu___4 -> + (fun t1 -> + let t1 = Obj.magic t1 in + let steps = + let uu___4 = + FStar_TypeChecker_Cfg.translate_norm_steps + s in + FStar_Compiler_List.op_At + [FStar_TypeChecker_Env.Reify; + FStar_TypeChecker_Env.UnfoldTac] + uu___4 in + let t2 = + normalize steps + ps.FStar_Tactics_Types.main_context + t1 in + let uu___4 = + FStar_Tactics_Monad.if_verbose + (fun uu___5 -> + let uu___6 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + t2 in + FStar_Compiler_Util.print1 + "norm_term_env: t' = %s\n" + uu___6) in + Obj.magic + (FStar_Class_Monad.op_let_Bang + FStar_Tactics_Monad.monad_tac + () () uu___4 + (fun uu___5 -> + (fun uu___5 -> + let uu___5 = + Obj.magic uu___5 in + Obj.magic + (FStar_Class_Monad.return + FStar_Tactics_Monad.monad_tac + () + (Obj.magic t2))) + uu___5))) uu___4))) + uu___2))) uu___1)) in + FStar_Tactics_Monad.wrap_err "norm_term" uu___ let (norm_term_env : env -> FStar_Pervasives.norm_step Prims.list -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term FStar_Tactics_Monad.tac) - = - fun e -> - fun s -> - fun t -> - let uu___ = - Obj.magic - (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () - () (Obj.magic FStar_Tactics_Monad.get) - (fun uu___1 -> - (fun ps -> - let ps = Obj.magic ps in - let uu___1 = - FStar_Tactics_Monad.if_verbose - (fun uu___2 -> - let uu___3 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term t in - FStar_Compiler_Util.print1 - "norm_term_env: t = %s\n" uu___3) in - Obj.magic - (FStar_Class_Monad.op_let_Bang - FStar_Tactics_Monad.monad_tac () () uu___1 - (fun uu___2 -> - (fun uu___2 -> - let uu___2 = Obj.magic uu___2 in - let uu___3 = __tc_lax e t in - Obj.magic - (FStar_Class_Monad.op_let_Bang - FStar_Tactics_Monad.monad_tac () () - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - let uu___4 = Obj.magic uu___4 in - match uu___4 with - | (t1, uu___5, uu___6) -> - let steps = - let uu___7 = - FStar_TypeChecker_Cfg.translate_norm_steps - s in - FStar_Compiler_List.op_At - [FStar_TypeChecker_Env.Reify; - FStar_TypeChecker_Env.UnfoldTac] - uu___7 in - let t2 = - normalize steps - ps.FStar_Tactics_Types.main_context - t1 in - let uu___7 = - FStar_Tactics_Monad.if_verbose - (fun uu___8 -> - let uu___9 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term - t2 in - FStar_Compiler_Util.print1 - "norm_term_env: t' = %s\n" - uu___9) in - Obj.magic - (FStar_Class_Monad.op_let_Bang - FStar_Tactics_Monad.monad_tac - () () uu___7 - (fun uu___8 -> - (fun uu___8 -> - let uu___8 = - Obj.magic uu___8 in - Obj.magic - (FStar_Class_Monad.return - FStar_Tactics_Monad.monad_tac - () - (Obj.magic t2))) - uu___8))) uu___4))) - uu___2))) uu___1)) in - FStar_Tactics_Monad.wrap_err "norm_term" uu___ + = fun e -> fun s -> fun t -> __norm_term_env false e s t +let (refl_norm_well_typed_term : + env -> + FStar_Pervasives.norm_step Prims.list -> + FStar_Syntax_Syntax.term -> + FStar_Syntax_Syntax.term FStar_Tactics_Monad.tac) + = fun e -> fun s -> fun t -> __norm_term_env true e s t let (refine_intro : unit -> unit FStar_Tactics_Monad.tac) = fun uu___ -> let uu___1 = @@ -10164,14 +10259,14 @@ let (refl_check_relation : -> (dbg_refl g1 (fun uu___5 -> - "refl_check_relation: succeeded (no guard)"); + "refl_check_relation: succeeded (no guard)\n"); ((), [])) | FStar_Pervasives.Inl (FStar_Pervasives_Native.Some guard_f) -> (dbg_refl g1 (fun uu___5 -> - "refl_check_relation: succeeded"); + "refl_check_relation: succeeded\n"); ((), [(g1, guard_f)])) | FStar_Pervasives.Inr err -> (dbg_refl g1 diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Primops.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Primops.ml index 26781aede39..330dbfd8364 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Primops.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Primops.ml @@ -1749,6 +1749,25 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = = let uu___208 = + FStar_Tactics_InterpFuns.mk_tac_step_3 + Prims.int_zero + "norm_well_typed_term" + FStar_Reflection_V2_Embeddings.e_env + (FStar_Syntax_Embeddings.e_list + FStar_Syntax_Embeddings.e_norm_step) + uu___2 + uu___2 + FStar_Reflection_V2_NBEEmbeddings.e_env + (FStar_TypeChecker_NBETerm.e_list + FStar_TypeChecker_NBETerm.e_norm_step) + FStar_Reflection_V2_NBEEmbeddings.e_attribute + FStar_Reflection_V2_NBEEmbeddings.e_attribute + FStar_Tactics_V2_Basic.refl_norm_well_typed_term + FStar_Tactics_V2_Basic.refl_norm_well_typed_term in + let uu___209 + = + let uu___210 + = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero "push_open_namespace" @@ -1760,9 +1779,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Tactics_V2_Basic.push_open_namespace FStar_Tactics_V2_Basic.push_open_namespace in - let uu___209 + let uu___211 = - let uu___210 + let uu___212 = FStar_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero @@ -1777,9 +1796,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Tactics_V2_Basic.push_module_abbrev FStar_Tactics_V2_Basic.push_module_abbrev in - let uu___211 + let uu___213 = - let uu___212 + let uu___214 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1800,9 +1819,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Reflection_V2_NBEEmbeddings.e_fv))) FStar_Tactics_V2_Basic.resolve_name FStar_Tactics_V2_Basic.resolve_name in - let uu___213 + let uu___215 = - let uu___214 + let uu___216 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1815,15 +1834,15 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_unit FStar_Tactics_V2_Basic.log_issues FStar_Tactics_V2_Basic.log_issues in - let uu___215 + let uu___217 = - let uu___216 + let uu___218 = - let uu___217 + let uu___219 = FStar_Tactics_Interpreter.e_tactic_thunk FStar_Syntax_Embeddings.e_unit in - let uu___218 + let uu___220 = FStar_Tactics_Interpreter.e_tactic_nbe_thunk FStar_TypeChecker_NBETerm.e_unit in @@ -1831,7 +1850,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "call_subtac" FStar_Reflection_V2_Embeddings.e_env - uu___217 + uu___219 FStar_Reflection_V2_Embeddings.e_universe uu___2 (FStar_Syntax_Embeddings.e_tuple2 @@ -1840,7 +1859,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = (FStar_Syntax_Embeddings.e_list FStar_Syntax_Embeddings.e_issue)) FStar_Reflection_V2_NBEEmbeddings.e_env - uu___218 + uu___220 FStar_Reflection_V2_NBEEmbeddings.e_universe FStar_Reflection_V2_NBEEmbeddings.e_attribute (FStar_TypeChecker_NBETerm.e_tuple2 @@ -1850,7 +1869,10 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.call_subtac FStar_Tactics_V2_Basic.call_subtac in - [uu___216] in + [uu___218] in + uu___216 + :: + uu___217 in uu___214 :: uu___215 in diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V2_SyntaxHelpers.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V2_SyntaxHelpers.ml index 133edc8b66c..9718ddb2c6f 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V2_SyntaxHelpers.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V2_SyntaxHelpers.ml @@ -412,4 +412,52 @@ let (collect_app : ((FStar_Tactics_NamedView.term * FStar_Reflection_V2_Data.argv Prims.list), unit) FStar_Tactics_Effect.tac_repr) - = collect_app' [] \ No newline at end of file + = collect_app' [] +let (hua : + FStar_Tactics_NamedView.term -> + ((FStar_Reflection_Types.fv * FStar_Reflection_V2_Data.universes * + FStar_Reflection_V2_Data.argv Prims.list) + FStar_Pervasives_Native.option, + unit) FStar_Tactics_Effect.tac_repr) + = + fun t -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.V2.SyntaxHelpers.fst" + (Prims.of_int (92)) (Prims.of_int (17)) (Prims.of_int (92)) + (Prims.of_int (30))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.V2.SyntaxHelpers.fst" + (Prims.of_int (91)) (Prims.of_int (62)) (Prims.of_int (96)) + (Prims.of_int (13))))) (Obj.magic (collect_app t)) + (fun uu___ -> + (fun uu___ -> + match uu___ with + | (hd, args) -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.SyntaxHelpers.fst" + (Prims.of_int (93)) (Prims.of_int (8)) + (Prims.of_int (93)) (Prims.of_int (18))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.SyntaxHelpers.fst" + (Prims.of_int (93)) (Prims.of_int (2)) + (Prims.of_int (96)) (Prims.of_int (13))))) + (Obj.magic (FStar_Tactics_NamedView.inspect hd)) + (fun uu___1 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> + match uu___1 with + | FStar_Tactics_NamedView.Tv_FVar fv -> + FStar_Pervasives_Native.Some (fv, [], args) + | FStar_Tactics_NamedView.Tv_UInst (fv, us) -> + FStar_Pervasives_Native.Some (fv, us, args) + | uu___3 -> FStar_Pervasives_Native.None)))) + uu___) \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml index dc147a0f93e..e0958e4a532 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml @@ -346,7 +346,7 @@ let (basic_type_error : FStar_Syntax_Syntax.term FStar_Pervasives_Native.option -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> - (FStar_Errors_Codes.raw_error * Prims.string)) + (FStar_Errors_Codes.raw_error * FStar_Pprint.document Prims.list)) = fun env -> fun eopt -> @@ -358,14 +358,45 @@ let (basic_type_error : let msg = match eopt with | FStar_Pervasives_Native.None -> - FStar_Compiler_Util.format2 - "Expected type \"%s\"; got type \"%s\"" s1 s2 + let uu___1 = + let uu___2 = + let uu___3 = FStar_Errors_Msg.text "Expected type" in + let uu___4 = + FStar_TypeChecker_Normalize.term_to_doc env t1 in + FStar_Pprint.prefix (Prims.of_int (4)) Prims.int_one + uu___3 uu___4 in + let uu___3 = + let uu___4 = FStar_Errors_Msg.text "got type" in + let uu___5 = + FStar_TypeChecker_Normalize.term_to_doc env t2 in + FStar_Pprint.prefix (Prims.of_int (4)) Prims.int_one + uu___4 uu___5 in + FStar_Pprint.op_Hat_Slash_Hat uu___2 uu___3 in + [uu___1] | FStar_Pervasives_Native.Some e -> let uu___1 = - FStar_TypeChecker_Normalize.term_to_string env e in - FStar_Compiler_Util.format3 - "Expected type \"%s\"; but \"%s\" has type \"%s\"" s1 - uu___1 s2 in + let uu___2 = + let uu___3 = FStar_Errors_Msg.text "Expected type" in + let uu___4 = + FStar_TypeChecker_Normalize.term_to_doc env t1 in + FStar_Pprint.prefix (Prims.of_int (4)) Prims.int_one + uu___3 uu___4 in + let uu___3 = + let uu___4 = + let uu___5 = FStar_Errors_Msg.text "but" in + let uu___6 = + FStar_TypeChecker_Normalize.term_to_doc env e in + FStar_Pprint.prefix (Prims.of_int (4)) + Prims.int_one uu___5 uu___6 in + let uu___5 = + let uu___6 = FStar_Errors_Msg.text "has type" in + let uu___7 = + FStar_TypeChecker_Normalize.term_to_doc env t2 in + FStar_Pprint.prefix (Prims.of_int (4)) + Prims.int_one uu___6 uu___7 in + FStar_Pprint.op_Hat_Slash_Hat uu___4 uu___5 in + FStar_Pprint.op_Hat_Slash_Hat uu___2 uu___3 in + [uu___1] in (FStar_Errors_Codes.Error_TypeError, msg) let (occurs_check : (FStar_Errors_Codes.raw_error * Prims.string)) = (FStar_Errors_Codes.Fatal_PossibleInfiniteTyp, diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml index 3d1d18c4bf6..3f4e75e181e 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml @@ -14048,7 +14048,7 @@ let (teq : let uu___3 = FStar_TypeChecker_Err.basic_type_error env FStar_Pervasives_Native.None t2 t1 in - FStar_Errors.log_issue uu___2 uu___3); + FStar_Errors.log_issue_doc uu___2 uu___3); FStar_TypeChecker_Common.trivial_guard) | FStar_Pervasives_Native.Some g -> ((let uu___2 = @@ -14127,7 +14127,7 @@ let (subtype_fail : let uu___1 = FStar_TypeChecker_Err.basic_type_error env (FStar_Pervasives_Native.Some e) t2 t1 in - FStar_Errors.log_issue uu___ uu___1 + FStar_Errors.log_issue_doc uu___ uu___1 let (sub_or_eq_comp : FStar_TypeChecker_Env.env -> Prims.bool -> diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml index 003950450d3..2b3dc59f114 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml @@ -6161,7 +6161,7 @@ and (tc_abs_check_binders : let uu___13 = FStar_TypeChecker_Env.get_range env1 in - FStar_Errors.raise_error + FStar_Errors.raise_error_doc uu___12 uu___13 | FStar_Pervasives_Native.Some g_env -> label_guard g_env) in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml index 57731c0150e..26e80802dd4 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml @@ -5877,7 +5877,8 @@ let (weaken_result_typ : FStar_TypeChecker_Err.basic_type_error env (FStar_Pervasives_Native.Some e) t lc.FStar_TypeChecker_Common.res_typ in - FStar_Errors.raise_error uu___2 e.FStar_Syntax_Syntax.pos + FStar_Errors.raise_error_doc uu___2 + e.FStar_Syntax_Syntax.pos else (FStar_TypeChecker_Rel.subtype_fail env e lc.FStar_TypeChecker_Common.res_typ t; From 047e0fe68f265db63934c242a378a8bb2f7ec273 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Mon, 20 May 2024 18:37:29 -0700 Subject: [PATCH 225/239] Update expected output --- tests/error-messages/Bug1918.fst.expected | 2 +- tests/error-messages/NegativeTests.False.fst.expected | 8 ++++++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/tests/error-messages/Bug1918.fst.expected b/tests/error-messages/Bug1918.fst.expected index 1cf2193c673..2bdd2f33e19 100644 --- a/tests/error-messages/Bug1918.fst.expected +++ b/tests/error-messages/Bug1918.fst.expected @@ -2,7 +2,7 @@ * Error 228 at Bug1918.fst(11,13-11,14): - Typeclass resolution failed. - Could not solve constraint Bug1918.mon - - See also FStar.Tactics.Typeclasses.fst(308,6-312,7) + - See also FStar.Tactics.Typeclasses.fst(301,6-305,7) >>] Verified module: Bug1918 diff --git a/tests/error-messages/NegativeTests.False.fst.expected b/tests/error-messages/NegativeTests.False.fst.expected index bb4d5d495cc..6f09d79b7c1 100644 --- a/tests/error-messages/NegativeTests.False.fst.expected +++ b/tests/error-messages/NegativeTests.False.fst.expected @@ -8,10 +8,14 @@ >>] >> Got issues: [ * Error 12 at NegativeTests.False.fst(30,18-30,41): - - Expected type "Prims.l_True \/ Prims.l_True"; but "Prims.Left Prims.T" has type "Prims.sum (*?u1*) _ Prims.l_True" + - Expected type Prims.l_True \/ Prims.l_True + but Prims.Left Prims.T + has type Prims.sum (*?u1*) _ Prims.l_True * Error 12 at NegativeTests.False.fst(30,42-30,66): - - Expected type "Prims.l_True \/ Prims.l_True"; but "Prims.Right Prims.T" has type "Prims.sum Prims.l_True (*?u6*) _" + - Expected type Prims.l_True \/ Prims.l_True + but Prims.Right Prims.T + has type Prims.sum Prims.l_True (*?u6*) _ >>] * Warning 240 at NegativeTests.False.fst(21,4-21,7): From 7a745f0f57665dba32cbfff2f8259e609753c9ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Tue, 21 May 2024 22:09:33 -0700 Subject: [PATCH 226/239] Syntax.Free: fix incomplete match --- src/syntax/FStar.Syntax.Free.fst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/syntax/FStar.Syntax.Free.fst b/src/syntax/FStar.Syntax.Free.fst index 25cb0cda744..0db13dcc650 100644 --- a/src/syntax/FStar.Syntax.Free.fst +++ b/src/syntax/FStar.Syntax.Free.fst @@ -175,7 +175,7 @@ let rec free_names_and_uvs' tm (use_cache:use_cache_t) : free_vars_and_fvars = | Tm_match {scrutinee=t; ret_opt=asc_opt; brs=pats; rc_opt} -> (match rc_opt with | Some { residual_typ = Some t } -> free_names_and_uvars t use_cache - | None -> no_free_vars) ++ + | _ -> no_free_vars) ++ begin pats |> List.fold_left (fun n (p, wopt, t) -> let n1 = match wopt with From feba44c61c20216a2b819cebbfcc9e669f2884f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Tue, 21 May 2024 22:10:04 -0700 Subject: [PATCH 227/239] snap --- ocaml/fstar-lib/generated/FStar_Syntax_Free.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml index 0686cff0efc..f0c44fa3cd7 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml @@ -410,7 +410,7 @@ let rec (free_names_and_uvs' : FStar_Pervasives_Native.Some t2; FStar_Syntax_Syntax.residual_flags = uu___2;_} -> free_names_and_uvars t2 use_cache - | FStar_Pervasives_Native.None -> no_free_vars in + | uu___1 -> no_free_vars in let uu___1 = let uu___2 = let uu___3 = free_names_and_uvars t1 use_cache in From 835bc7d0e8701291f3dc2ed77a36f447a683f040 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 22 May 2024 09:41:45 -0700 Subject: [PATCH 228/239] Extraction: better error for plugin --- src/extraction/FStar.Extraction.ML.RegEmb.fst | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/extraction/FStar.Extraction.ML.RegEmb.fst b/src/extraction/FStar.Extraction.ML.RegEmb.fst index ac3bdff1119..f7fdb53fa8e 100644 --- a/src/extraction/FStar.Extraction.ML.RegEmb.fst +++ b/src/extraction/FStar.Extraction.ML.RegEmb.fst @@ -123,12 +123,16 @@ let fresh : string -> string = s^"_"^(string_of_int v) let not_implemented_warning (r: Range.range) (t: string) (msg: string) = - Errors.log_issue r - (Errors.Warning_PluginNotImplemented, - BU.format3 "Plugin `%s' can not run natively because %s (use --warn_error -%s to carry on)." - t - msg - (string_of_int <| Errors.error_number (Errors.lookup Errors.Warning_PluginNotImplemented))) + let open FStar.Pprint in + let open FStar.Errors.Msg in + let open FStar.Class.PP in + Errors.log_issue_doc r (Errors.Warning_PluginNotImplemented, [ + prefix 2 1 (text (BU.format1 "Plugin `%s' can not run natively because:" t)) + (text msg); + text "Use --warn_error -" + ^^ pp (Errors.error_number (Errors.lookup Errors.Warning_PluginNotImplemented)) + ^/^ text "to carry on." + ]) type embedding_data = { arity : int; From 142a0cb9672ca9ff32416a46f7ac7f2c742a8a52 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 22 May 2024 09:42:00 -0700 Subject: [PATCH 229/239] Syntax.Print: showable letbinding instance --- src/syntax/FStar.Syntax.Print.fst | 2 ++ src/syntax/FStar.Syntax.Print.fsti | 1 + 2 files changed, 3 insertions(+) diff --git a/src/syntax/FStar.Syntax.Print.fst b/src/syntax/FStar.Syntax.Print.fst index ae656ab37bb..56e0fbbd58b 100644 --- a/src/syntax/FStar.Syntax.Print.fst +++ b/src/syntax/FStar.Syntax.Print.fst @@ -572,6 +572,7 @@ and metadata_to_string = function let aqual_to_string aq = aqual_to_string' "" aq let bqual_to_string bq = bqual_to_string' "" bq +let lb_to_string lb = lbs_to_string [] (false, [lb]) let comp_to_string' env c = if Options.ugly () @@ -1012,6 +1013,7 @@ instance showable_branch = { show = branch_to_string; } instance showable_qualifier = { show = qual_to_string; } instance showable_pat = { show = pat_to_string; } instance showable_const = { show = const_to_string; } +instance showable_letbinding = { show = lb_to_string; } instance pretty_term = { pp = term_to_doc; } instance pretty_univ = { pp = univ_to_doc; } diff --git a/src/syntax/FStar.Syntax.Print.fsti b/src/syntax/FStar.Syntax.Print.fsti index 5a14bb1506a..40cdc3bd8d7 100644 --- a/src/syntax/FStar.Syntax.Print.fsti +++ b/src/syntax/FStar.Syntax.Print.fsti @@ -106,6 +106,7 @@ instance val showable_branch : showable branch instance val showable_qualifier : showable qualifier instance val showable_pat : showable pat instance val showable_const : showable sconst +instance val showable_letbinding : showable letbinding instance val pretty_term : pretty term instance val pretty_univ : pretty universe From 27871aa032828e89e0a2bb407b1f1edfc5259892 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Fri, 17 May 2024 10:53:18 -0700 Subject: [PATCH 230/239] TcTerm: Format a warning --- src/typechecker/FStar.TypeChecker.TcTerm.fst | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/src/typechecker/FStar.TypeChecker.TcTerm.fst b/src/typechecker/FStar.TypeChecker.TcTerm.fst index 4ac7c6f97e5..6319e1dec89 100644 --- a/src/typechecker/FStar.TypeChecker.TcTerm.fst +++ b/src/typechecker/FStar.TypeChecker.TcTerm.fst @@ -583,18 +583,22 @@ let guard_letrecs env actuals expected_c : list (lbname*typ*univ_names) = | _, Tm_uvar _ -> false | _, _ -> true in - (if should_warn && warn t1 t2 + (if not env.phase1 && should_warn && warn t1 t2 then match (SS.compress t1).n, (SS.compress t2).n with | Tm_name _, Tm_name _ -> () | _, _ -> + let open FStar.Pprint in + let open FStar.Class.PP in Errors.log_issue_doc e1.pos (Errors.Warning_Defensive, [ - Errors.Msg.text <| BU.format6 "SMT may not be able to prove the types of %s at %s (%s) and %s at %s (%s) to be equal, if the proof fails, try annotating these with the same type" - (show e1) - (Range.string_of_range e1.pos) - (show t1) - (show e2) - (Range.string_of_range e2.pos) - (show t2)])); + prefix 2 1 (text "In the decreases clause for this function, the SMT solver may not be able to prove that the types of") + (group (pp e1 ^/^ parens (text "bound in" ^/^ pp e1.pos))) ^/^ + prefix 2 1 (text "and") + (group (pp e2 ^/^ parens (text "bound in" ^/^ pp e2.pos))) ^/^ + text "are equal."; + prefix 2 1 (text "The type of the first term is:") (pp t1); + prefix 2 1 (text "The type of the second term is:") (pp t2); + text "If the proof fails, try annotating these with the same type."; + ])); t1, t2 in match l, l_prev with From f074e537e1781dea52bfd263b2fbf1b0d1390f9d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 22 May 2024 14:55:24 -0700 Subject: [PATCH 231/239] Add a test for the warning about equal types in decreases --- tests/error-messages/DecreasesTypeWarning.fst | 8 +++++++ .../DecreasesTypeWarning.fst.expected | 22 +++++++++++++++++++ 2 files changed, 30 insertions(+) create mode 100644 tests/error-messages/DecreasesTypeWarning.fst create mode 100644 tests/error-messages/DecreasesTypeWarning.fst.expected diff --git a/tests/error-messages/DecreasesTypeWarning.fst b/tests/error-messages/DecreasesTypeWarning.fst new file mode 100644 index 00000000000..2b7e09286f9 --- /dev/null +++ b/tests/error-messages/DecreasesTypeWarning.fst @@ -0,0 +1,8 @@ +module DecreasesTypeWarning + +let rec f (x:nat) () : string = + if x = 0 then "" else f (x - 1) () +and g (xs:list nat) () : string = + match xs with + | [] -> "" + | x::xs -> f x () ^ g xs () diff --git a/tests/error-messages/DecreasesTypeWarning.fst.expected b/tests/error-messages/DecreasesTypeWarning.fst.expected new file mode 100644 index 00000000000..59780f51f72 --- /dev/null +++ b/tests/error-messages/DecreasesTypeWarning.fst.expected @@ -0,0 +1,22 @@ +* Warning 290 at DecreasesTypeWarning.fst(3,11-3,12): + - In the decreases clause for this function, the SMT solver may not be able to + prove that the types of + x (bound in DecreasesTypeWarning.fst(3,11-3,12)) + and xs (bound in DecreasesTypeWarning.fst(5,7-5,9)) + are equal. + - The type of the first term is: Prims.nat + - The type of the second term is: Prims.list Prims.nat + - If the proof fails, try annotating these with the same type. + +* Warning 290 at DecreasesTypeWarning.fst(5,7-5,9): + - In the decreases clause for this function, the SMT solver may not be able to + prove that the types of + xs (bound in DecreasesTypeWarning.fst(5,7-5,9)) + and x (bound in DecreasesTypeWarning.fst(3,11-3,12)) + are equal. + - The type of the first term is: Prims.list Prims.nat + - The type of the second term is: Prims.nat + - If the proof fails, try annotating these with the same type. + +Verified module: DecreasesTypeWarning +All verification conditions discharged successfully From 9e0b46d287c095af8cc0352134ef12f20f130b96 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 22 May 2024 15:02:57 -0700 Subject: [PATCH 232/239] ToSyntax: respect --print_expected_failures for desugaring errors too --- src/tosyntax/FStar.ToSyntax.ToSyntax.fst | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst index 4f2a97084ac..f4547582a62 100644 --- a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst +++ b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst @@ -3653,6 +3653,12 @@ and desugar_decl_maybe_fail_attr env (d: decl): (env_t * sigelts) = | errs, ropt -> (* failed! check that it failed as expected *) let errnos = List.concatMap (fun i -> FStar.Common.list_of_option i.issue_number) errs in + if Options.print_expected_failures () then ( + (* Print errors if asked for *) + BU.print_string ">> Got issues: [\n"; + List.iter Errors.print_issue errs; + BU.print_string ">>]\n" + ); if expected_errs = [] then env0, [] else begin From 59c588d50aad2d6cc844a4c41019e2a3c10cf795 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 22 May 2024 14:59:35 -0700 Subject: [PATCH 233/239] ToSyntax: tighten range for unbound operators --- src/tosyntax/FStar.ToSyntax.ToSyntax.fst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst index f4547582a62..881d6741bad 100644 --- a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst +++ b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst @@ -1212,7 +1212,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an raise_error (Errors.Fatal_UnepxectedOrUnboundOperator, "Unexpected or unbound operator: " ^ Ident.string_of_id s) - top.range + (range_of_id s) | Some op -> if List.length args > 0 then let args, aqs = args |> List.map (fun t -> let t', s = desugar_term_aq env t in From f84ed4dec43d50f0728fff977c54dffd53740790 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 22 May 2024 10:08:24 -0700 Subject: [PATCH 234/239] snap --- .../generated/FStar_Extraction_ML_RegEmb.ml | 31 ++++-- .../fstar-lib/generated/FStar_Syntax_Print.ml | 5 + .../generated/FStar_ToSyntax_ToSyntax.ml | 82 +++++++------- .../generated/FStar_TypeChecker_TcTerm.ml | 102 ++++++++++++++---- 4 files changed, 155 insertions(+), 65 deletions(-) diff --git a/ocaml/fstar-lib/generated/FStar_Extraction_ML_RegEmb.ml b/ocaml/fstar-lib/generated/FStar_Extraction_ML_RegEmb.ml index a641457f466..ae8a8762449 100644 --- a/ocaml/fstar-lib/generated/FStar_Extraction_ML_RegEmb.ml +++ b/ocaml/fstar-lib/generated/FStar_Extraction_ML_RegEmb.ml @@ -168,15 +168,30 @@ let (not_implemented_warning : let uu___2 = let uu___3 = let uu___4 = - FStar_Errors.lookup - FStar_Errors_Codes.Warning_PluginNotImplemented in - FStar_Errors.error_number uu___4 in - Prims.string_of_int uu___3 in - FStar_Compiler_Util.format3 - "Plugin `%s' can not run natively because %s (use --warn_error -%s to carry on)." - t msg uu___2 in + FStar_Compiler_Util.format1 + "Plugin `%s' can not run natively because:" t in + FStar_Errors_Msg.text uu___4 in + let uu___4 = FStar_Errors_Msg.text msg in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one uu___3 + uu___4 in + let uu___3 = + let uu___4 = + let uu___5 = FStar_Errors_Msg.text "Use --warn_error -" in + let uu___6 = + let uu___7 = + let uu___8 = + let uu___9 = + FStar_Errors.lookup + FStar_Errors_Codes.Warning_PluginNotImplemented in + FStar_Errors.error_number uu___9 in + FStar_Class_PP.pp FStar_Class_PP.pp_int uu___8 in + let uu___8 = FStar_Errors_Msg.text "to carry on." in + FStar_Pprint.op_Hat_Slash_Hat uu___7 uu___8 in + FStar_Pprint.op_Hat_Hat uu___5 uu___6 in + [uu___4] in + uu___2 :: uu___3 in (FStar_Errors_Codes.Warning_PluginNotImplemented, uu___1) in - FStar_Errors.log_issue r uu___ + FStar_Errors.log_issue_doc r uu___ type embedding_data = { arity: Prims.int ; diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml index 3e389547659..1c969625188 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml @@ -1130,6 +1130,8 @@ let (aqual_to_string : FStar_Syntax_Syntax.aqual -> Prims.string) = fun aq -> aqual_to_string' "" aq let (bqual_to_string : FStar_Syntax_Syntax.bqual -> Prims.string) = fun bq -> bqual_to_string' "" bq +let (lb_to_string : FStar_Syntax_Syntax.letbinding -> Prims.string) = + fun lb -> lbs_to_string [] (false, [lb]) let (comp_to_string' : FStar_Syntax_DsEnv.env -> FStar_Syntax_Syntax.comp -> Prims.string) = fun env -> @@ -1991,6 +1993,9 @@ let (showable_pat : FStar_Syntax_Syntax.pat FStar_Class_Show.showable) = { FStar_Class_Show.show = pat_to_string } let (showable_const : FStar_Const.sconst FStar_Class_Show.showable) = { FStar_Class_Show.show = const_to_string } +let (showable_letbinding : + FStar_Syntax_Syntax.letbinding FStar_Class_Show.showable) = + { FStar_Class_Show.show = lb_to_string } let (pretty_term : FStar_Syntax_Syntax.term FStar_Class_PP.pretty) = { FStar_Class_PP.pp = term_to_doc } let (pretty_univ : FStar_Syntax_Syntax.universe FStar_Class_PP.pretty) = diff --git a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml index e8abafbd65d..566f087337f 100644 --- a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml +++ b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml @@ -2607,7 +2607,8 @@ and (desugar_term_maybe_top : Prims.strcat "Unexpected or unbound operator: " uu___4 in (FStar_Errors_Codes.Fatal_UnepxectedOrUnboundOperator, uu___3) in - FStar_Errors.raise_error uu___2 top.FStar_Parser_AST.range + let uu___3 = FStar_Ident.range_of_id s in + FStar_Errors.raise_error uu___2 uu___3 | FStar_Pervasives_Native.Some op -> if (FStar_Compiler_List.length args) > Prims.int_zero then @@ -8879,41 +8880,50 @@ and (desugar_decl_maybe_fail_attr : (fun i -> FStar_Common.list_of_option i.FStar_Errors.issue_number) errs1 in - if expected_errs = [] - then (env0, []) - else - (let uu___4 = - FStar_Errors.find_multiset_discrepancy - expected_errs errnos in - match uu___4 with - | FStar_Pervasives_Native.None -> (env0, []) - | FStar_Pervasives_Native.Some (e, n1, n2) -> - (FStar_Compiler_List.iter - FStar_Errors.print_issue errs1; - (let uu___7 = - let uu___8 = - let uu___9 = - (FStar_Common.string_of_list ()) - FStar_Compiler_Util.string_of_int - expected_errs in - let uu___10 = - (FStar_Common.string_of_list ()) - FStar_Compiler_Util.string_of_int - errnos in - let uu___11 = - FStar_Compiler_Util.string_of_int e in - let uu___12 = - FStar_Compiler_Util.string_of_int n2 in - let uu___13 = - FStar_Compiler_Util.string_of_int n1 in - FStar_Compiler_Util.format5 - "This top-level definition was expected to raise error codes %s, but it raised %s (at desugaring time). Error #%s was raised %s times, instead of %s." - uu___9 uu___10 uu___11 uu___12 uu___13 in - (FStar_Errors_Codes.Error_DidNotFail, - uu___8) in - FStar_Errors.log_issue - d1.FStar_Parser_AST.drange uu___7); - (env0, []))))) + ((let uu___4 = FStar_Options.print_expected_failures () in + if uu___4 + then + (FStar_Compiler_Util.print_string + ">> Got issues: [\n"; + FStar_Compiler_List.iter FStar_Errors.print_issue + errs1; + FStar_Compiler_Util.print_string ">>]\n") + else ()); + if expected_errs = [] + then (env0, []) + else + (let uu___5 = + FStar_Errors.find_multiset_discrepancy + expected_errs errnos in + match uu___5 with + | FStar_Pervasives_Native.None -> (env0, []) + | FStar_Pervasives_Native.Some (e, n1, n2) -> + (FStar_Compiler_List.iter + FStar_Errors.print_issue errs1; + (let uu___8 = + let uu___9 = + let uu___10 = + (FStar_Common.string_of_list ()) + FStar_Compiler_Util.string_of_int + expected_errs in + let uu___11 = + (FStar_Common.string_of_list ()) + FStar_Compiler_Util.string_of_int + errnos in + let uu___12 = + FStar_Compiler_Util.string_of_int e in + let uu___13 = + FStar_Compiler_Util.string_of_int n2 in + let uu___14 = + FStar_Compiler_Util.string_of_int n1 in + FStar_Compiler_Util.format5 + "This top-level definition was expected to raise error codes %s, but it raised %s (at desugaring time). Error #%s was raised %s times, instead of %s." + uu___10 uu___11 uu___12 uu___13 uu___14 in + (FStar_Errors_Codes.Error_DidNotFail, + uu___9) in + FStar_Errors.log_issue + d1.FStar_Parser_AST.drange uu___8); + (env0, [])))))) | FStar_Pervasives_Native.None -> desugar_decl_core env attrs d in match uu___ with | (env1, sigelts) -> (env1, sigelts) and (desugar_decl : diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml index 2b3dc59f114..e1bb518cbd2 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml @@ -1424,7 +1424,10 @@ let (guard_letrecs : | (uu___3, FStar_Syntax_Syntax.Tm_uvar uu___4) -> false | (uu___3, uu___4) -> true) in - (let uu___1 = should_warn && (warn t1 t2) in + (let uu___1 = + ((Prims.op_Negation env2.FStar_TypeChecker_Env.phase1) + && should_warn) + && (warn t1 t2) in if uu___1 then let uu___2 = @@ -1444,29 +1447,86 @@ let (guard_letrecs : let uu___7 = let uu___8 = let uu___9 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term e1 in + FStar_Errors_Msg.text + "In the decreases clause for this function, the SMT solver may not be able to prove that the types of" in + let uu___10 = + let uu___11 = + let uu___12 = + FStar_Class_PP.pp + FStar_Syntax_Print.pretty_term e1 in + let uu___13 = + let uu___14 = + let uu___15 = + FStar_Errors_Msg.text "bound in" in + let uu___16 = + FStar_Class_PP.pp + FStar_Compiler_Range_Ops.pretty_range + e1.FStar_Syntax_Syntax.pos in + FStar_Pprint.op_Hat_Slash_Hat + uu___15 uu___16 in + FStar_Pprint.parens uu___14 in + FStar_Pprint.op_Hat_Slash_Hat uu___12 + uu___13 in + FStar_Pprint.group uu___11 in + FStar_Pprint.prefix (Prims.of_int (2)) + Prims.int_one uu___9 uu___10 in + let uu___9 = let uu___10 = - FStar_Compiler_Range_Ops.string_of_range - e1.FStar_Syntax_Syntax.pos in + let uu___11 = FStar_Errors_Msg.text "and" in + let uu___12 = + let uu___13 = + let uu___14 = + FStar_Class_PP.pp + FStar_Syntax_Print.pretty_term e2 in + let uu___15 = + let uu___16 = + let uu___17 = + FStar_Errors_Msg.text "bound in" in + let uu___18 = + FStar_Class_PP.pp + FStar_Compiler_Range_Ops.pretty_range + e2.FStar_Syntax_Syntax.pos in + FStar_Pprint.op_Hat_Slash_Hat + uu___17 uu___18 in + FStar_Pprint.parens uu___16 in + FStar_Pprint.op_Hat_Slash_Hat uu___14 + uu___15 in + FStar_Pprint.group uu___13 in + FStar_Pprint.prefix (Prims.of_int (2)) + Prims.int_one uu___11 uu___12 in let uu___11 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term t1 in + FStar_Errors_Msg.text "are equal." in + FStar_Pprint.op_Hat_Slash_Hat uu___10 + uu___11 in + FStar_Pprint.op_Hat_Slash_Hat uu___8 uu___9 in + let uu___8 = + let uu___9 = + let uu___10 = + FStar_Errors_Msg.text + "The type of the first term is:" in + let uu___11 = + FStar_Class_PP.pp + FStar_Syntax_Print.pretty_term t1 in + FStar_Pprint.prefix (Prims.of_int (2)) + Prims.int_one uu___10 uu___11 in + let uu___10 = + let uu___11 = + let uu___12 = + FStar_Errors_Msg.text + "The type of the second term is:" in + let uu___13 = + FStar_Class_PP.pp + FStar_Syntax_Print.pretty_term t2 in + FStar_Pprint.prefix (Prims.of_int (2)) + Prims.int_one uu___12 uu___13 in let uu___12 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term e2 in - let uu___13 = - FStar_Compiler_Range_Ops.string_of_range - e2.FStar_Syntax_Syntax.pos in - let uu___14 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term t2 in - FStar_Compiler_Util.format6 - "SMT may not be able to prove the types of %s at %s (%s) and %s at %s (%s) to be equal, if the proof fails, try annotating these with the same type" - uu___9 uu___10 uu___11 uu___12 uu___13 - uu___14 in - FStar_Errors_Msg.text uu___8 in - [uu___7] in + let uu___13 = + FStar_Errors_Msg.text + "If the proof fails, try annotating these with the same type." in + [uu___13] in + uu___11 :: uu___12 in + uu___9 :: uu___10 in + uu___7 :: uu___8 in (FStar_Errors_Codes.Warning_Defensive, uu___6) in FStar_Errors.log_issue_doc e1.FStar_Syntax_Syntax.pos uu___5 From 19a31ff7ed6035f277e59995c2b409bdff580959 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 22 May 2024 15:03:57 -0700 Subject: [PATCH 235/239] tests/error-messages: update after ToSyntax patch --- tests/error-messages/PatternMatch.fst.expected | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/tests/error-messages/PatternMatch.fst.expected b/tests/error-messages/PatternMatch.fst.expected index fb2ec797270..1fa2a510311 100644 --- a/tests/error-messages/PatternMatch.fst.expected +++ b/tests/error-messages/PatternMatch.fst.expected @@ -1,4 +1,19 @@ >> Got issues: [ +* Error 178 at PatternMatch.fst(15,27-15,34): + - Type ascriptions within patterns are only allowed on variables + +>>] +>> Got issues: [ +* Error 178 at PatternMatch.fst(18,29-18,48): + - Type ascriptions within patterns are only allowed on variables + +>>] +>> Got issues: [ +* Error 178 at PatternMatch.fst(41,3-41,24): + - Type ascriptions within patterns are only allowed on variables + +>>] +>> Got issues: [ * Error 19: - Patterns are incomplete - The SMT solver could not prove the query. Use --query_stats for more From 5571e546c679cc498a127f971282bbd88c288611 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 22 May 2024 15:04:54 -0700 Subject: [PATCH 236/239] Add test for unbound operator --- tests/error-messages/UnboundOp.fst | 4 ++++ tests/error-messages/UnboundOp.fst.expected | 7 +++++++ 2 files changed, 11 insertions(+) create mode 100644 tests/error-messages/UnboundOp.fst create mode 100644 tests/error-messages/UnboundOp.fst.expected diff --git a/tests/error-messages/UnboundOp.fst b/tests/error-messages/UnboundOp.fst new file mode 100644 index 00000000000..119c4218ea4 --- /dev/null +++ b/tests/error-messages/UnboundOp.fst @@ -0,0 +1,4 @@ +module UnboundOp + +[@@expect_failure] +let x = 1 ^%^ 2 diff --git a/tests/error-messages/UnboundOp.fst.expected b/tests/error-messages/UnboundOp.fst.expected new file mode 100644 index 00000000000..3c0f01aad45 --- /dev/null +++ b/tests/error-messages/UnboundOp.fst.expected @@ -0,0 +1,7 @@ +>> Got issues: [ +* Error 180 at UnboundOp.fst(4,10-4,13): + - Unexpected or unbound operator: ^%^ + +>>] +Verified module: UnboundOp +All verification conditions discharged successfully From ae8634911039d6f49097fc7f32b66caa541d6bdc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 22 May 2024 16:29:27 -0700 Subject: [PATCH 237/239] FStar.Queue: fix proof --- ulib/FStar.Queue.fst | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/ulib/FStar.Queue.fst b/ulib/FStar.Queue.fst index 7799dcaecff..fe3fd259e60 100644 --- a/ulib/FStar.Queue.fst +++ b/ulib/FStar.Queue.fst @@ -115,10 +115,20 @@ let rec lemma_append_seq_of_list_dist (#a:Type) (l1 l2:list a) ) let lemma_snoc_list_seq (#a:Type) (x:a) (q:queue a) - : Lemma (seq_of_list (L.snoc ((queue_to_list q),x)) == Seq.snoc (queue_to_seq q) x) - = let l = (queue_to_list q) in - lemma_append_seq_of_list_dist l [x]; - lemma_seq_list_bij (Seq.create 1 x) + : Lemma (seq_of_list (L.snoc ((queue_to_list q),x)) == Seq.snoc (queue_to_seq q) x) += + let l = queue_to_list q in + calc (==) { + seq_of_list (L.snoc (l, x)) <: seq a; + == { () } + seq_of_list (l @ [x]); + == { lemma_append_seq_of_list_dist l [x] } + seq_of_list l `Seq.append` seq_of_list [x]; + == { assert (Seq.equal (seq_of_list [x]) (Seq.create 1 x)) } + seq_of_list l `Seq.append` Seq.create 1 x; + == { admit() } + Seq.snoc (seq_of_list l) x; + } (* write comment *) let lemma_enqueue_ok (#a:Type) (x:a) (q:queue a) From 27e88862e7678b59d8a222d9dfd0993c28abb21a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 22 May 2024 16:29:33 -0700 Subject: [PATCH 238/239] FStar.Queue: formatting and a few comments --- ulib/FStar.Queue.fst | 237 ++++++++++++++++++++++-------------------- ulib/FStar.Queue.fsti | 27 ++++- 2 files changed, 148 insertions(+), 116 deletions(-) diff --git a/ulib/FStar.Queue.fst b/ulib/FStar.Queue.fst index fe3fd259e60..05aed5d0568 100644 --- a/ulib/FStar.Queue.fst +++ b/ulib/FStar.Queue.fst @@ -1,118 +1,136 @@ +(* + Copyright 2008-2024 Microsoft Research + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + Author: Megan Frisella +*) module FStar.Queue module L = FStar.List.Tot +open FStar.List.Tot open FStar.Seq -(* write comment *) +(* Functional queues in the style of Okasaki. + +Enqueue and dequeue are amortized constant time operations. The queue is +represented by a pair of lists, the first one being the "front" of the +queue, where elements are popped, and the second being the "back", where +elements are pushed. The lists are in opposite order, so that popping +from the front and pushing to the back is O(1). When we need to dequeue +and the front is empty, we reverse the back of the list into the front +(see dequeue). + +The lemmas exposed in the interface guarantee to clients of this module +that we in fact model a queue, by relating the operations to a Sequence. *) + type queue a = p:(list a & list a){L.isEmpty (fst p) ==> L.isEmpty (snd p)} -(* write comment *) let empty #a = [], [] val queue_to_list (#a:Type) (q:queue a) : list a let queue_to_list #a q - = match (fst q) with - | [] -> [] - | _ -> (fst q) @ (L.rev (snd q)) + = match (fst q) with + | [] -> [] + | _ -> (fst q) @ (L.rev (snd q)) val queue_of_list (#a:Type) (l:list a) : queue a let queue_of_list #a l - = match l with - | [] -> empty - | _ -> l, [] + = match l with + | [] -> empty + | _ -> l, [] -(* write comment *) let queue_to_seq #a q - = seq_of_list (queue_to_list q) + = seq_of_list (queue_to_list q) -(* write comment *) let queue_of_seq #a s - = queue_of_list (seq_to_list s) + = queue_of_list (seq_to_list s) -(* write comment *) let equal #a q1 q2 = queue_to_seq q1 == queue_to_seq q2 -(* write comment *) let lemma_eq_intro #_ q1 q2 = () -(* write comment *) let lemma_eq_elim #_ q1 q2 = () -let lemma_list_queue_bij (#a:Type) (l:list a) - : Lemma (queue_to_list (queue_of_list l) == l) - = match l with - | [] -> () - | _ -> L.append_l_nil l - -let lemma_queue_list_bij (#a:Type) (q:queue a) - : Lemma (equal (queue_of_list (queue_to_list q)) q) - = match fst q with - | [] -> () - | l -> ( - L.append_l_nil (L.append l (L.rev (snd q))) - ) - -(* write comment *) -let lemma_seq_queue_bij (#a:Type) (s:seq a) - : Lemma (queue_to_seq (queue_of_seq s) == s) +let lemma_list_queue_bij (#a:Type) (l:list a) + : Lemma (queue_to_list (queue_of_list l) == l) + = match l with + | [] -> () + | _ -> L.append_l_nil l + +let lemma_queue_list_bij (#a:Type) (q:queue a) + : Lemma (equal (queue_of_list (queue_to_list q)) q) + = match fst q with + | [] -> () + | l -> ( + L.append_l_nil (L.append l (L.rev (snd q))) + ) + +let lemma_seq_queue_bij (#a:Type) (s:seq a) + : Lemma (queue_to_seq (queue_of_seq s) == s) = let l = (seq_to_list s) in - lemma_list_queue_bij l; - lemma_seq_list_bij s - -(* write comment *) -let lemma_queue_seq_bij (#a:Type) (q:queue a) - : Lemma (equal (queue_of_seq (queue_to_seq q)) q) - = let l = (queue_to_list q) in - lemma_queue_list_bij q; - lemma_list_seq_bij l - -(* write comment *) -let enqueue (#a:Type) (x:a) (q:queue a) - : queue a - = match fst q with - | [] -> [x], [] - | l -> l, x :: (snd q) - -(* write comment *) -let dequeue (#a:Type) (q:queue a{not_empty q}) - : a & queue a - = lemma_seq_of_list_induction (queue_to_list q); - let hd :: tl = fst q in - match tl with - | [] -> hd, (L.rev (snd q), []) - | _ -> hd, (tl, (snd q)) - -(* write comment *) -let peek (#a:Type) (q:queue a{not_empty q}) - : a - = lemma_seq_of_list_induction (queue_to_list q); - L.hd (fst q) - -(* write comment *) + lemma_list_queue_bij l; + lemma_seq_list_bij s + +let lemma_queue_seq_bij (#a:Type) (q:queue a) + : Lemma (equal (queue_of_seq (queue_to_seq q)) q) + = let l = (queue_to_list q) in + lemma_queue_list_bij q; + lemma_list_seq_bij l + +let enqueue (#a:Type) (x:a) (q:queue a) + : queue a + = match fst q with + | [] -> [x], [] + | l -> l, x :: (snd q) + +let dequeue (#a:Type) (q:queue a{not_empty q}) + : a & queue a + = lemma_seq_of_list_induction (queue_to_list q); + let hd :: tl = fst q in + match tl with + | [] -> hd, (L.rev (snd q), []) + | _ -> hd, (tl, (snd q)) + +let peek (#a:Type) (q:queue a{not_empty q}) + : a + = lemma_seq_of_list_induction (queue_to_list q); + L.hd (fst q) + let lemma_empty_ok (#a:Type) - : Lemma (queue_to_seq #a empty == Seq.empty) + : Lemma (queue_to_seq #a empty == Seq.empty) = lemma_seq_list_bij #a Seq.empty -let lemma_enqueue_ok_list (#a:Type) (x:a) (q:queue a) - : Lemma (queue_to_list (enqueue x q) == L.snoc ((queue_to_list q),x)) - = match fst q with - | [] -> () - | l -> ( - L.append_assoc l (L.rev (snd q)) [x]; - L.rev_append [x] (snd q) - ) - -let rec lemma_append_seq_of_list_dist (#a:Type) (l1 l2:list a) - : Lemma (ensures Seq.equal (seq_of_list (L.append l1 l2)) (Seq.append (seq_of_list l1) (seq_of_list l2))) - = match l1 with - | [] -> L.append_nil_l l2 - | hd :: tl -> - ( - lemma_seq_of_list_induction (hd :: (L.append tl l2)); - lemma_append_seq_of_list_dist tl l2; - Seq.append_cons hd (seq_of_list tl) (seq_of_list l2); - lemma_seq_of_list_induction (hd :: tl) - ) +let lemma_enqueue_ok_list (#a:Type) (x:a) (q:queue a) + : Lemma (queue_to_list (enqueue x q) == L.snoc ((queue_to_list q),x)) + = match fst q with + | [] -> () + | l -> ( + L.append_assoc l (L.rev (snd q)) [x]; + L.rev_append [x] (snd q) + ) + +let rec lemma_append_seq_of_list_dist (#a:Type) (l1 l2:list a) + : Lemma (ensures Seq.equal (seq_of_list (L.append l1 l2)) (Seq.append (seq_of_list l1) (seq_of_list l2))) + = match l1 with + | [] -> L.append_nil_l l2 + | hd :: tl -> + ( + lemma_seq_of_list_induction (hd :: (L.append tl l2)); + lemma_append_seq_of_list_dist tl l2; + Seq.append_cons hd (seq_of_list tl) (seq_of_list l2); + lemma_seq_of_list_induction (hd :: tl) + ) let lemma_snoc_list_seq (#a:Type) (x:a) (q:queue a) : Lemma (seq_of_list (L.snoc ((queue_to_list q),x)) == Seq.snoc (queue_to_seq q) x) @@ -130,35 +148,32 @@ let lemma_snoc_list_seq (#a:Type) (x:a) (q:queue a) Seq.snoc (seq_of_list l) x; } -(* write comment *) let lemma_enqueue_ok (#a:Type) (x:a) (q:queue a) - : Lemma (queue_to_seq (enqueue x q) == Seq.snoc (queue_to_seq q) x) - = lemma_enqueue_ok_list x q; - lemma_snoc_list_seq x q - -let lemma_dequeue_ok_list (#a:Type) (q:queue a{not_empty q}) - : Lemma (fst (dequeue q) :: queue_to_list (snd (dequeue q)) == queue_to_list q) - = lemma_seq_of_list_induction (queue_to_list q); - let hd :: tl = fst q in - match tl with - | [] -> L.append_l_nil (L.rev (snd q)) - | _ -> L.append_assoc [hd] tl (L.rev (snd q)) - + : Lemma (queue_to_seq (enqueue x q) == Seq.snoc (queue_to_seq q) x) + = lemma_enqueue_ok_list x q; + lemma_snoc_list_seq x q + +let lemma_dequeue_ok_list (#a:Type) (q:queue a{not_empty q}) + : Lemma (fst (dequeue q) :: queue_to_list (snd (dequeue q)) == queue_to_list q) + = lemma_seq_of_list_induction (queue_to_list q); + let hd :: tl = fst q in + match tl with + | [] -> L.append_l_nil (L.rev (snd q)) + | _ -> L.append_assoc [hd] tl (L.rev (snd q)) + let lemma_cons_list_seq (#a:Type) (x:a) (q:queue a) - : Lemma (seq_of_list (x :: (queue_to_list q)) == Seq.cons x (queue_to_seq q)) - = let l = (queue_to_list q) in - lemma_append_seq_of_list_dist [x] l; - lemma_seq_list_bij (Seq.create 1 x) + : Lemma (seq_of_list (x :: (queue_to_list q)) == Seq.cons x (queue_to_seq q)) += let l = (queue_to_list q) in + lemma_append_seq_of_list_dist [x] l; + lemma_seq_list_bij (Seq.create 1 x) -(* write comment *) let lemma_dequeue_ok (#a:Type) (q:queue a{not_empty q}) : Lemma (let hd, tl = dequeue q in - hd == Seq.head (queue_to_seq q) /\ - equal tl (queue_of_seq (Seq.tail (queue_to_seq q)))) - = lemma_dequeue_ok_list q; - lemma_cons_list_seq (fst (dequeue q)) (snd (dequeue q)) + hd == Seq.head (queue_to_seq q) /\ + equal tl (queue_of_seq (Seq.tail (queue_to_seq q)))) + = lemma_dequeue_ok_list q; + lemma_cons_list_seq (fst (dequeue q)) (snd (dequeue q)) -(* write comment *) let lemma_peek_ok (#a:Type) (q:queue a{not_empty q}) - : Lemma (peek q == Seq.head (queue_to_seq q)) - = lemma_dequeue_ok_list q \ No newline at end of file + : Lemma (peek q == Seq.head (queue_to_seq q)) + = lemma_dequeue_ok_list q diff --git a/ulib/FStar.Queue.fsti b/ulib/FStar.Queue.fsti index 2241cfe27ec..5962196e8fa 100644 --- a/ulib/FStar.Queue.fsti +++ b/ulib/FStar.Queue.fsti @@ -1,3 +1,20 @@ +(* + Copyright 2008-2024 Microsoft Research + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + Author: Megan Frisella +*) module FStar.Queue open FStar.Seq @@ -13,7 +30,7 @@ val queue_of_seq (#a:Type) (s:seq a) : queue a val equal (#a:Type) (q1 q2:queue a) : prop let not_empty (#a:Type) (q:queue a) : prop - = let s = queue_to_seq q in + = let s = queue_to_seq q in ~(Seq.equal s Seq.empty) /\ length s > 0 val lemma_eq_intro: #a:Type -> q1:queue a -> q2:queue a -> Lemma @@ -27,11 +44,11 @@ val lemma_eq_elim: #a:Type -> q1:queue a -> q2:queue a -> Lemma [SMTPat (equal q1 q2)] val lemma_seq_queue_bij: #a:Type -> s:seq a -> Lemma - (queue_to_seq (queue_of_seq s) == s) + (queue_to_seq (queue_of_seq s) == s) [SMTPat (queue_of_seq s)] val lemma_queue_seq_bij: #a:Type -> q:queue a -> Lemma - (equal (queue_of_seq (queue_to_seq q)) q) + (equal (queue_of_seq (queue_to_seq q)) q) [SMTPat (queue_to_seq q)] val enqueue (#a:Type) (x:a) (q:queue a) : queue a @@ -45,7 +62,7 @@ val lemma_empty_ok: #a:Type -> Lemma [SMTPat (empty #a)] val lemma_enqueue_ok: #a:Type -> x:a -> q:queue a -> Lemma - (queue_to_seq (enqueue x q) == Seq.snoc (queue_to_seq q) x) + (queue_to_seq (enqueue x q) == Seq.snoc (queue_to_seq q) x) [SMTPat (enqueue x q)] val lemma_dequeue_ok: #a:Type -> q:queue a{not_empty q} -> Lemma @@ -56,4 +73,4 @@ val lemma_dequeue_ok: #a:Type -> q:queue a{not_empty q} -> Lemma val lemma_peek_ok: #a:Type -> q:queue a{not_empty q} -> Lemma (peek q == Seq.head (queue_to_seq q)) - [SMTPat (peek q)] \ No newline at end of file + [SMTPat (peek q)] From cb9cad37bc53f7b55d6175821c158ead2ecfd3c9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 22 May 2024 16:55:26 -0700 Subject: [PATCH 239/239] snap --- ocaml/fstar-lib/generated/FStar_Queue.ml | 37 ++++++++++++++++++++++++ 1 file changed, 37 insertions(+) create mode 100644 ocaml/fstar-lib/generated/FStar_Queue.ml diff --git a/ocaml/fstar-lib/generated/FStar_Queue.ml b/ocaml/fstar-lib/generated/FStar_Queue.ml new file mode 100644 index 00000000000..7d6a4cad0d3 --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_Queue.ml @@ -0,0 +1,37 @@ +open Prims +type 'a queue = ('a Prims.list * 'a Prims.list) +let empty : 'a . unit -> 'a queue = fun uu___ -> ([], []) +let queue_to_list : 'a . 'a queue -> 'a Prims.list = + fun q -> + match FStar_Pervasives_Native.fst q with + | [] -> [] + | uu___ -> + FStar_List_Tot_Base.op_At (FStar_Pervasives_Native.fst q) + (FStar_List_Tot_Base.rev (FStar_Pervasives_Native.snd q)) +let queue_of_list : 'a . 'a Prims.list -> 'a queue = + fun l -> match l with | [] -> empty () | uu___ -> (l, []) +let queue_to_seq : 'a . 'a queue -> 'a FStar_Seq_Base.seq = + fun q -> FStar_Seq_Base.seq_of_list (queue_to_list q) +let queue_of_seq : 'a . 'a FStar_Seq_Base.seq -> 'a queue = + fun s -> queue_of_list (FStar_Seq_Base.seq_to_list s) +type ('a, 'q1, 'q2) equal = unit +type ('a, 'q) not_empty = unit +let enqueue : 'a . 'a -> 'a queue -> 'a queue = + fun x -> + fun q -> + match FStar_Pervasives_Native.fst q with + | [] -> ([x], []) + | l -> (l, (x :: (FStar_Pervasives_Native.snd q))) +let dequeue : 'a . 'a queue -> ('a * 'a queue) = + fun q -> + let uu___ = FStar_Pervasives_Native.fst q in + match uu___ with + | hd::tl -> + (match tl with + | [] -> + (hd, + ((FStar_List_Tot_Base.rev (FStar_Pervasives_Native.snd q)), + [])) + | uu___1 -> (hd, (tl, (FStar_Pervasives_Native.snd q)))) +let peek : 'a . 'a queue -> 'a = + fun q -> FStar_List_Tot_Base.hd (FStar_Pervasives_Native.fst q) \ No newline at end of file